AD-A18,  641  §mcTOMK§8°P2JUSiET8^87<U>  ftM  J0!NI  PR0CM" 


UNCLASSIFIED 


F/C  12/3 


NL 


E  (When  Data  Entez&i/  * 


1ENTAT ION  PAGE 


AD-A189  641 


Advanced  Ada  Workshop,  August,  1987 


RE  AO  INSTRUCTIONS 
BEFORE  COMPLETING  FORM 


2.  GOvr  ACCESSION  NO.  3.  RECIPIENT'S  CATALOG  NUMBER 


*utTAa°f  ,R^2gT.  f7P-^°«  lWE° 


6.  PERFORMING  ORG.  REPORT  NUMBER 


7.  AUTHORCs) 

Ada  Software  Engineering  Education  and  Training  Team  ( ASEET) 


8.  CONTRACT  OR  GRANT  NUMBER(s) 


9.  PERFORMING  ORGANIZATION  AND  AOORESS 

Ada  Software  Education  and  Training  Team 
Ada  Joint  Program  Office,  3E114,  The 
Pentagon,  Washington,  D.C. 20301-3081 


11.  CONTROLLING  OFFICE  NAME  AND  AOORESS 

Ada  Joint  Program  Office 
,  3E  114,  The  Pentaaon 
Washington,  DC  20301-3081 


14.  MONITORING  AGENCY  NAME  i  S00RtSS(lf  different  ■  jm  Controlling  Office) 

Ada  Joint  Program  Office 


16.  DISTRIBUTION  STATEMENT  (of  this  Report) 


10.  PROGRAM  ELEMENT.  PROJECT.  TASK 
AREA  a  WORK  UNIT  NUMBERS 


12.  REPORT  DATE 

3  December.  1986 


15.  SECURITY  CLASS  (of  rhs  ’eport) 

'  UNCLASSIFIED 


15a.  ^C^ASSpiCATION.  DOWNGRADING 

N/A 


Approved  for  public  release;  distribution  unlimited. 


17.  DISTRIBUTION  STATEMENT  (of  the  abstract  entered  in  Block  20.  If  different  from  Report) 

UNCLASSIFIED 


18.  SUPPLEMENTARY  NOTES 


DT!C 

LECTT* 


JAN  0  6  1988 d 

C-p  ^ 


19  .  KEYWORDS  (Continue  on  reverse  side  if  necessary  and  identify  by  block  number) 


Ada  Programming  language,  Ada  Training,  Education,  Training,  Computer 
Programs,  Ada  Joint  Program  Office,  AJPO _  ^ : - - - 


20  .  ABSTRACT  (Continue  on  reverse  side  if  necessary  and  identify  by  block  number) 


This  document  contains  prints  of  slides  presented  at  the  Advanced^da 
Workshop,  Monday,  17  August  to  Friday,  21  August,  1987. 


HJK*  1473 

EDITION  OF  1  NOV  65  IS  OBSOLETE 

1  JAM  73  S/N  0102-LF-Q 14-660  1  _ UNCLASSIFIED _ 

SECURITY  CLASSIFICATION  OF  T  H I  b  PAGE  (When  Data  tnre'ed) 


APPLIED  Ada  SOFTWARE  ENGINEERING 

*  Basic  Problea 

—  Projection  to  the  1990's 
—  A  Macro  Solution 

*  A  Practical  Solution 

Software  Engineering 
Ada 

*  Software  Engineering 
—  Goals 

—  Principles 

*  Why  Ada  ? 

—  Features  of  Ada 

—  Software  Engineering 
Applications 


BASIC  PROBLEM 

Projection  to  the  1990's 

Multiprocessors  -  Networks  and 
Parallel  Architectures 

Distributed  Databases 

Hardware  Capabilities 

Software  Demands 


Hardware  Costs 


DISTRIBUTED  DATABASES 

Central  Control  Over  Data 
Minimize  Effort  in  Storing  Data 
“The  Ada  Package  Store' 


HARDWARE  CAPABILITIES 

Mainframe  in  a  Micro 

—  Intel  80286,  80386,  80486,  ??? 

—  Motorola  68000,  68010,  68020,  68030, 
Screen  Resolution 

—  Desktop  Publishing,  CAD/CAM 
Storage  Devices 

—  100+  MB  Hard  Disks 

Access  Times  -  18  as  to  40  as 
Opens  Hew  Fields  of  Applications 


SOFTWARE  DEMANDS 

*  New  Users  with  Consumer  Relationships 

*  Non-Technical  Arenas 
—  Need  Guarantees 

—  Demand  Reliability 

*  Development  is  the  Key 
—  Design  is  Paramount 

-  Simplistic  Operations;  i.e.  TV 

—  Costs  of  Errors 


Other  Considerations 


A  MACRO  SOLUTION 

*  Greater  Use  of  Automation 

*  Higher  Levels  of  Abstraction 

*  Reaseabllity 

—  Isolate  Commonality 
—  Create  Workable  Abstractions 
—  Reuseable  Parts  Library 

*  Rapid  Prototyping 

Gain  Insight 

—  Evaluate  Design  Expectations 
—  Compare  Design  Alternatives 

A  solution  offered  by  Edward  Lieblein 


A  PRACTICAL  SOLOTIOH 


Software  Engineering  Myths 

*  Anyone  Can  Be  a  Software  Engineer 

*  Automated  Tools  ”  Software  Engineering 

*  Structured  Programming  *  Software  Engineering 

*  Structured  Analysis  “  Software  Engineering 

*  Code  Re-use  *  Software  Engineering 

*  It  Hill  Make  Programming  Obsolete 

*  Al  Hill  Make  It  Effortless 

*  Fantastic  Productivity  Gains 

*  Ada  -  Software  Engineering 


SOFTWARE  ENGINEERING 

A  PRACTICAL  SOLUTION 

*  What  Is  It  ? 

*  Why  Is  It  Needed  ? 

*  The  State  of  the  Art 

*  The  State  of  the  Practice 

*  Why  Now  ? 


CHARACTERISTICS  OF  DoD  SOFTWARE 


▼ 


i 


O 


■O 

0 

0 

L_ 

-O 

CL 

o 

0 

CD 

V 

0 

O 

c 
•  ■ 

o 

jQ 

D 

OT 

O 

CD 

jQ 

o 

1 _ J 

c 

CO 

3 

C 

CD 

Cl 

L_ 

o 

•  —  . 

*0 

L_  - 

3 

O 
♦  « 

M— 

*o 

E 

0 

-+_j 

X 

CJ 

t — 

c 

M— 

c 

o 

LJ 

L_ 

3 

b 

3 

■Jf 

* 

* 

* 

*• 

FACTORS  AFFECTING  DoD  SOFTWARE 


*  Software  professionals 
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‘  Size  constraints 
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CONTENT  AREAS 


*  Software  engineering  projects 


The  quality  of  a  programming  language  for 
software  engineering  is  determined  by-how  well 
it  supports  a  design  methodology  and  its 
underlying  models,  principles,  and  concepts 
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A  PRACTICAL  SOLUTION 

Ada 

Ada  and  Software  Engineering 

They  Aren’t  the  Saae  Thing 

Ada  Has  Unique  Features  That 
Facilitates  Software  Engineerin 

Tou  CAM  Write  Bad  Code  in  Ada 

Ada  Is  MOT  the  Total  Answer 
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LANGUAGE  DEVELOPMENT 
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SOFTWARE  ENGINEERING 

Goals  of  Software  Engineering 
Principles  of  Software  Engineering 


PRINCIPLES  OF  SOFTWARE  ENGINEERING 


*  Uniformity 
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COMPLETENESS 


FEATURES  OF  Ada 


Supports  Large  System  Development 

Supports  Structured  Programming 

Supports  Top-Down  Development 

Supports  Strong  Data  Typing 

Supports  Data  Abstraction 

Supports  Information  Hiding  and 
Data  Encapsulation 


SYSTEMS  ENGINEERING 


*  Test  total  system 
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*  There  is  a  clear  distinction  between  architecture 
and  implementation 
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Prevalent  across  engineering  disciplines 
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*  Definition 
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end  ICEJCREAM; 
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end  loop; 

end  COUNtlARGE; 

begin 

null;  — tasks  are  started  here 
end  COUNT-NUMBERS; 
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PUT  ( A.NUMBER  ); 
NEWJJNE; 
end  loop; 

end  GELNUMBERS; 
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end  GELNUMBERS; 
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Outline 


1.  Rationale 

Are  generics  really  necessary  In  Ada? 
What  can  they  do? 


2.  Syntax  and  Semantics 
Generic  parameters 
Instantiation 

Compared  with  other  Ada  units 


3.  Examples 

See  how  simple  they  can  be. 

See  how  useful  they  can  be. 

See  how  complicated  they  can  be. 

4.  Limitations 

Some  generalization  is  not  easy. 
Some  generalization  is  not  possible. 

5.  Advanced  Usage 

Retrofitting  generics 
Generalization  judgement  calls 


1.  Rationale 


Are  generics  really  necessary? 

Ada  language  goals: 

Encapsulation  of  processing  desired 
Encapsulation  of  resources  (objects)  desired 
User-defined  types  desired 
Strong,  static  type  checking  desired 
Unnecessary  language  features  not  desired 
Reusability  desired 

Other  languages  answer  some  of  these  goals,  but  not  all. 
Fortran 

Encapsulation  of  processing  supported 
Encapsulation  of  resources  (mostly) 

No  user-defined  types 

No  static  type  checking 

I/O  routines  part  of  language  definition 

Some  reusability  support 

Pascal 

Encapsulation  of  processing  supported 
No  encapsulation  of  resources 
User-defined  types 

Strong,  static  type  checking  (with  loopholes) 
I/O  routines  part  of  language  definition 
No  reusability  support 

Smalltalk 

Encapsulation  of  processing  supported 
Encapsulation  of  resources  supported 
User-defined  types  supported 
No  static  type  checking 
Only  primitive  I/O  language-defined 
Excellent  reusability  support 


Generics  Are  Solution 


Some  of  the  above  goals  appear  to  be  in  conflict: 

•  Reusability  vs.  Strong  static  type  checking  -  ? 

type  User_Type  is  new  Integer; 

procedure  Increment  (X  :  In  out  User_Type)  is 

begin 

X  :=  X  +  1 ; 
end  Increment; 

Cannot  reuse  Increment  anywhere  else. 


•  Strong  checking  vs.  Minimal  language  --  ? 

type  User_Type  Is  new  Integer; 

X :  UserJType; 

I :  Integer; 

Put  (X);  -  for  strong  checking,  these 

Put  (I);  -  must  be  distinct  "Put’s" 

Pascal  solves  this  with  "magic"  I/O  procedures 
•  extended  language 

Write  (X); 

Write  (I); 

Write  (X,  I); 

Write  (The  answer  is  X,  ’  or  I); 

Smalltalk  provides  primitive  I/O  with  each  new  type 
Might  not  be  wanted. 

Does  not  provide  static  checking 
This  allows  great  flexibility  but  can  lead  to 
runtime  errors  that  could  have  been 
avoided  by  compilation-time  checking 


The  Case  for  Generics 


Ada  generics  allow  excellent  compromise 


Minimal  additional  complexity 


Encapsulation  of  processing 
Generic  subprograms 


Encapsulation  of  resources  (objects) 
Generic  packages 


User-defined  types  desired 
Strong,  static  type  checking  desired 


Unnecessary  language  features  avoided 
I/O  not  part  of  language  (rather,  part 
of  the  standard  environment) 


Reusability  supported 

Reasonable  flexibility 
Capability  to  separate  essential  detail 
of  an  algorithm  or  object  from 
problem-specific  detail 


(Hint:  that  last  point  Is  tha  essence  of  generic  programming) 


What  can  Generics  Do? 


Consider  the  rationale  for  programming  anything: 

A  programmed  solution: 

Generalizes  over  several  occurrences 
Appropriate  if  similar  processing, 
but  with  varying  values 

Typical  programs  contain: 

•  Conceptual  "chunks"  related  to  the  general 

problem  class: 

Algorithms 

Objects  or  classes  of  objects 

•  Details  about  the  specific  problem 

Specific  types 

Specific  routines,  such  as  error  recovery 
Specific  data  flow  designs 

•  At  run  time,  a  specific  case  is  handled 

Values  specific  to  a  given  run  are  used 
Same  program  is  "reused"  with  next  set 
of  values 

Likewise,  generic  programming  uses: 

•  Conceptual  chunks,  object  classes 

•  Problem-specifics 


Run-time  specifics 


Traditional  Programming  -  Diagram 


Algorithms,  Objects,  Resources 

-  -  Intertwined  with  -  - 

Problem-specific  declarations 

package  Useful  Object  is 

type  Specific_Type  is  (Something_or_other); 

procedure  Do_Something  (To  :  Specific_Type); 

function  Status.Of  (An_Object_Of  :  Specif ic_Type) 
return  Predefined_Type_Perhaps; 


end  Useful_Object; 


Generic  Programming  -  Diagram 


application-domain  application-domain 

algorithms  object  classes 


problem-specific  declarations 

problem-specific  processing 

instantiations  of  the  application-domain 
chunks  (above  the  dashed  line) 

generic 

type  Formal_Type  is  private; 

package  General.Object  is 

procedure  Do_Something  (To  :  Formal_Type); 

function  Status_Of  (An_Object_Of :  Formal_Type) 
return  Predefined_Type_Perhaps; 

end  General_Object; 


type  Specitic_Type  is  (Someth  in  g_or_other); 

package  Useful_Object  is  new 

General.Object  (Specif  ic_Type); 


Another  Quick  Example 


Frequently,  the  following  occurs  in  Ada  programs: 


package  Global_Types  is 

type  Useful  is  (This,  That,  The_Other); 
end  Global_Types; 


with  Global_Types; 
package  Service  is 

procedure  Operation 

(On  :  Global_Types.Useful); 
end  Service; 


with  Global_Types; 
with  Service; 
procedure  User  is 

My_Object :  Global_Types.Useful; 

begin 

Service.Operation  (My_Object); 
end  User; 


Cannot  separately  use  Service  without  also  using 
Global.Types  due  to  visibility  requirements. 


Alternative,  Equivalent  Program 


package  GlobaHTypes  is 

type  Useful  is  (Whatever); 
end  Global_Types; 


-  no  context  clause 
generic 

type  Formal  is  private; 
package  General_Service  is 

procedure  Operation  (On  :  Formal); 
end  General_Service; 


with  Service; 
with  Global_Types; 
procedure  User  is 

My  Object :  Global_Types. Useful; 
package  Service  is  new 

General_Servlce  (Global_Types.Useful); 

begin 

Service.Operation  (My_Object); 
end  User; 


Now,  General_Service  can  be  reused  without 
GlobalJTypes. 


Just  as  a  program  becomes  a  specific  case  for  a 
given  run,  a  generic  program  is  instantiated 
into  a  specific  case  for  a  given  program. 


Another  Reason  Generics  are  Unavoidable 


With  only  predefined  types,  reusability  is  simplified: 

function  Math_Operation  (X  :  Real)  return  Real; 

If  users  only  have  type  Real  for  floating  point, 
the  above  function  is  always  usable 

However: 


Ada  allows  user-defined  types,  such  as: 

type  Low_Precision  is  digits  3; 
type  High_Precision  is  digits  7; 


And,  Ada  requires  strong  static  type  checking,  so 
if  Math_Operation  were  needed  for  both  of 
the  above  types,  two  functions  would  be  needed: 

function  Math_Operation  (X  :  Low_Precision) 
return  Low_Precision; 

function  Math_Operation  (X  :  High_Precision) 
return  High_Precision; 


Generics  solve  this  problem: 
generic 

type  Real  is  digits  <>; 

function  Math_Operation  (X  :  Real)  return  Real; 


Analogy  with  Programming 


Typical  programming: 


A  programmed  solution  can  be  written  once  and  "used1 
several  times.  The  following  motivate  the 
creation  of  a  programmed  solution: 


Reusability: 

Similar  processing  will  be  required  repeatedly. 


Reliability: 

Testing  and  verification  can  be  performed 
to  help  ensure  all  runs  will  be  correct. 


Readability: 

By  allowing  variables  to  stand  for  specific 
values  during  run  time,  the  program 
can  be  understood  In  the  abstract. 


Maintainability: 

Making  a  change  in  the  program  wiil  apply 
to  all  usages. 


Generic  Programming: 


Ail  the  same  arguments  can  be  applied  to  generic 
programming. 


£  Reusability: 

Similar  program  components  needed 
.  repeatedly,  but  different  enough  to 

preclude  run  time  parameterization. 


Reliability: 

A  properly  tested  generic  need  not  be 
retested  each  time  it  is  used. 


Readability: 

By  supressing  problem-specific  detail 
the  higher-level  concept  can  be  understood. 


Maintainability: 

By  helping  to  avoid  repetition,  the  (hopefully 
single)  location  where  a  change  is  required 
is  easier  to  determine. 


Simplified  View 


Just  as  types  are  templates  for  describing  objects, 

Generics  are  merely  templates  for  other  program  units. 

Generic  packages 

Generic  subprograms 
Generic  procedures 
Generic  functions 

There  are  no  generic  tasks 

-  a  task  is  already  an  object  of  a  type. 

-  a  generic  package  can  contain  a  task 


A  generic  (template)  is  instantiated  by  a 

declaration  just  as  an  object  is  an  "instance" 
of  a  type  (template). 


This  instantiation  is  accomplished  by  the  compiler, 
and  not  (necessarily)  at  run  time. 


The  effect  of  Ada  generics  can  be  obtained  through 
editor-like  substitution  (but  this  is  noi  the 
smartest  implementation  of  them) 


Sometimes  likened  to  assembly  language  Macros. 


Simple  Examples 


If  you  can  write  an  Ada  package,  procedure,  or  function 
(you  can,  can't  you?) 
then  you  can  write  an  Ada  generic: 


procedure  Easy  is 
begin 

TextJo.PutJJne  ("pie"); 
end  Easy; 

-  a  call  to  Easy: 

Easy; 

Generic  version: 

generic 

procedure  Easy^is 
begin 

TextJo.PutJJne  ("pie"); 
end  Easy; 

-  first  an  instantiation: 

procedure  Easyjnstance  is  new  Easy; 

~  then  a  call: 

Easyjnstance: 

Note  the  need  to  instantiate  first,  then  treat  as  a 
regular  procedure. 

The  above  generic  is  a  trivial  case  with  no  parameters. 

It's  possible  (but  not  too  likely)  that  such  a  simple 
generic  might  be  useful. 


The  preceeding  example  must  have  been  In  the  scope 
of  package  Textjo. 


Or,  It  could  have  been  a  library  unit  with  Its  own 
context  clause: 

with  Textjo; 
generic 

procedure  Easy  is 
begin 

TextJo.PutJJne  ("pie"); 
end  Easy; 


Generics  are  one  of  the  possible  library  units. 

Recalling  the  Ada  grammar: 

Library JJnit  ::= 

subprogramdeclaration 

package_declaration 

generic.declaration 

generlcjnstantiation 


subprog  ramjjody 


Note  that  a  generic  instantiation  can  also  be  a  library 
unit. 


Given  the  foregoing,  the  following  two  lines  also 
form  a  library  unit: 


with  Easy; 

procedure  Easyjnstance  is  new  Easy; 


And  a  user  could  be: 


with  Easyjnstance; 
procedure  User  is 
begin 

Easyjnstance; 
end  User; 

Resulting  in  "pie"  being  printed. 


These  trivial  cases  should  illustrate  the  hidden 
simplicity  in  the  declaration  and  use  of 
Ada  generics. 


More  Useful  Example 


Normally,  one  or  more  parameters  would  be  used 
to  allow  a  variety  of  Instances  to  be  declared. 


generic 

Prompt :  String  :=  "A>"; 
procedure  Issue.Prompt; 

with  Text  Jo; 

procedure  lssue_Prompt  is 
begin 

TextJo.Put  (Prompt); 
end  lssue_Prompt; 


Note,  the  context  clause  could  have  preceeded  the 
spec  but  it  isn't  needed  until  the  body. 


Note  that  the  separate  spec  and  body  is  Required 
with  generic  subprograms,  unlike  regular  subprograms. 

The  following  is  Not  allowed: 

with  Textjo; 
generic 

Prompt :  String  :=  "A>"; 
procedure  lssue_Prompt  is 
begin 

TextJo.Put  (Prompt); 
end  lssue_Prompt; 


Instantiations 


The  above  could  be  instantiated  with  the  following: 


with  lssue_Prompt; 
with  Text  Jo; 

function  User_Reply  return  String  Is 
procedure  Prompt  is  new 

lssue_Prompt  ("What  is  your  wish?  "); 
Buffer :  String  (1..80); 

Length:  Natural; 

begin 

Prompt; 

TextJo.Get_Llne  (Buffer,  Length); 
return  Buffer  (1  ..Length); 
end  UserJRepiy; 


with  lssue_Prompt; 
with  Textjo; 

function  User_Reply  (To_Questlon:  String  :=  "") 
return  String  is 
procedure  Prompt  is  new 

lssue_Prompt  (T  o_Question); 

Buffer :  String  (1..80); 

Length:  Natural; 

begin 

Prompt; 

TextJo.GetJJne  (Buffer,  Length); 
return  Buffer  (1  ..Length); 
end  User_Reply; 


Continued... 


Respl  :  constant  String  :=  User_Reply;  -what’s  wrong? 
Resp2  :  constant  String  :=  User_Reply  ("Why?  "); 
Resp3  :  constant  String  :=  User_Reply; 

What  is  your  wish?  _ 

Why? _ 

A> 


Another  Example 


Generic  formal  type  parameter  (any  floating  point  type) 
followed  by  an  object  parameter  of  that  type: 


generic 

type  Real  Is  digits  o; 

Max  :  Real  :=  Real'Last; 
procedure  Useless; 

procedure  Useless  is 

Local :  Real  :=  Max  /  2.0; 

begin 

if  Real'Last  >  Max  then 

Local  :=  Real'Last  /  2.0; 
end  if; 
end  Useless; 


with  Useless; 

procedure  Useless_User  Is 
type  Coarse  is  digits  3; 
procedure  Zip  is  new  Useless 
(Real  =>  Coarse, 

Max  =>  10.0); 

procedure  Zap  Is  new  Useless  (Coarse); 
procedure  Zot  is  new  Useless  (Float,  >1.0); 

begin 

zip; 

end  Useless.User; 


Object  Parameters  -  Detail 

As  with  subprogram  parameters,  generic  formal 
parameters  can  have  modes: 

Mode  in  is  the  default. 

generic 

Objl  :  Integer; 

Ob]2 :  in  Integer; 
procedure  Testing; 

procedure  Testing  is 
begin 

Objl  :=  Ob|2;  -  no! 
end  Testing; 


In  Parameters 


Mode  In  parameters  act  as  constants. 

Mode  in  parameters  are  passed  values  (as  with  in 
parameters  of  subprograms). 


with  Testing; 
procedure  Test  is 

X,  Y  :  Integer  :=  29; 

procedure  Fee  is  new  Testing  (3  +  X,  7); 
procedure  Fie  is  new  Testing  (X,  Y); 

begin 

Fee; 
end  Test; 


Mode  in  parameters  are  given  values  as  In  assignment 
(unlike  subprogram  in  parameters  -  see  later). 


with  Testing; 
procedure  Test  is 

X  :  Integer;  -  unitialized 
procedure  Bomb  is  new  Testing  (X,  X); 

begin 

t 

Bomb;  -  erroneous 
end  Test; 


Default  Evaluation 


Defaults  are  evaluated  at  time  of  Instantiation 
(Not  at  time  of  elaboration  of  generic) 

package  Declaration_Shell  is 

function  Num  return  Integer; 

generic 

Val  :  Integer  :=  Num; 
procedure  Demo; 

end  Declaration_Shell; 

package  body  Declaration_Shel!  is 

Local :  Integer  :=  0; 

function  Num  return  Integer  is 
begin 

Local  :=  Local  +  1 ; 
return  Local; 
end  Num; 

procedure  Demo  is  separate; 
end  Declaration_She!l; 
with  Text  Jo; 

separate  (Deciaration.Shell) 
procedure  Demo  is 
begin 

TextJo.PutJJne  (Integer'Image  (Val)); 
end  Demo; 


So, . . . 


with  Declaration_Shell; 
procedure  Show  is 

procedure  Demo  is 

new  Declaration_Shell.Demo; 

procedure  Demol  is 

new  Declaration_She(I.Demo; 


begin 

Demo; 
Demol ; 
end  Show; 


output: 

1 

2 


Not: 


1 

1 


Mode  in  out 


Mode  in  out  parameters  must  be  passed  variables,  not 
values  (same  as  in  out  subprogram  parameters) 


Formal  objects  of  mode  in  out  are  aliases  for  their 
actual  counterparts. 


Can  be  confusing  -  and  is  usually  not  recommended. 


The  evaluation  of  the  variable  represented  by  a  name 
supplied  as  the  actual  parameter  to  an  in  out 
generic  formal  object  parameter  occurs  once 


Therefore,  if  some  expression  in  the  name  evaluation 
changes  after  the  instantiation,  no  change  is  made 
to  the  object  represented  by  the  formal  name. 


Test  your  knowledge! 


declare 

Y  :  array  (1..5)  of  Character  :=  "kitty”; 

Index  :  Integer  1 ; 

generic 

X  :  in  out  Character; 
procedure  Gen; 

procedure  Gen  is 
begin 

Index  :=  5; 

X  :=  ’w'; 

Put  (String  (Y) ); 

end; 

procedure  P  is  new  Gen  (Y  (Index) ); 

begin 

P; 

end; 


What  would  happen  if  the  object  passed  depended 
on  the  value  of  a  discriminant? 


Is  this  Reasonable? 


declare 

type  Furniture  Is  (Bed,  Couch,  Table); 
type  Style  (F  :  Furniture  :=  Bed)  Is  record 
case  F  is 

when  Bed  => 

Four_Poster :  Boolean; 
when  Couch  => 

Convertible  :  Boolean; 
when  Table  => 

Legs  :  Integer; 

end  case; 
end  record; 

S  :  Style; 
generic 

X  :  in  out  Boolean; 
procedure  Gen; 

procedure  Gen  is 
begin 

S  :=  (Table,  4); 

-  what  is  the  value  of  X  ?? 

end; 

procedure  P  is  new  Gen  (S.Four_Poster); 


begin 

P; 


end; 


Would  the  above  be  allowed? 


Other  points 


Mode  £Ui  Is  not  available. 

What  would  that  mean,  anyway? 


Formal  objects  are  not  static,  so  they  can't  be  used 
in  the  generic  in  case  alternatives,  type  ranges, 
floating  point  precisions,  etc. 


declare 

generic 

X :  Integer; 

procedure  Gen  (Val  :  integer); 

procedure  Gen  (Val :  Integer)  is 
begin 

case  Val  is 

when  X  => 

•  •  • 

when  others  => 

a  a  a 

end  case; 
end  Gen; 

procedure  P  is  new  Gen  (X  =>  5); 

begin 

P  (Val  =>  8); 

end; 


You  guessed  it,  this  is  illegal,  too! 


Parametric  Confusion 


When  the  subprograms  have  parameters,  the  syntax 
can  be  confusing. 


Generic  formats  preceed  specification  but  parameter 
list  follows  instantiation. 


Subsequent  parameters  to  instance  also  follow, 

but  name  is  instance  name  now  not  generic  name. 


So,  the  text  never  quite  matches  up,  as  with 
subprograms! 


declare 

generic 

Gen_Formal :  Integer; 
procedure  G  (Proc_Formal :  Boolean); 

procedure  G  (Proc_Formal  :  Boolean)  is 
begin 

Put  (Gen_Formal); 

Put  (Proc_Formal); 
end  G; 

procedure  P  is  new  G  (Gen_Formal  =>  3); 

begin 

P  (Proc_Formal  =>  False); 


end; 


Enough  on  objects...  Type  Parameters 


The  real  power  of  generics  is  revealed  through 
the  use  of  type  (and  subprogram  -  later)  parameters 


Type  Parameters 

type  T  is  digits  <>;  -  any  floating  point  type 

type  T  is  delta  <>;  -  any  fixed  point  type 

type  T  is  range  <>;  -  any  integer  type 

type  T  is  (<>);  --  any  discrete  type,  which 

~  includes  integer  types 


Note  allowable  operations  on  above,  such  as  'First, 
’Last,  ’Succ,  ’Pred,  ,  "+” ,  etc. ,  are 
available  only  as  appropriate  (minimum 
assumptions) 


generic 

type  Counter  is  (o); 

function  Gen_F  (X  :  Counter)  return  Counter; 

function  Gen_F  (X  :  Counter)  return  Counter  is 
begin 

return  X  +  1 ;  -  oops 
end  Gen_F; 


Private  Formal  Parameters 


type  T  is  private; 

Good  news:  any  type  except  a  limited 
type  will  match  this  formal. 

Bad  news:  you  can  only  declare  objects, 
assign  values  to  objects,  and  test 
for  equality  (just  those  operations 
you  would  expect  to  be  able  to 
perform  on  a  private  type). 


type  T  is  limited  private; 

Good  news:  any  type  including  a  limited 
type  will  match  this  formal. 

Bad  news:  you  can  only  declare  objects 
and  nothing  else  (just  what 
you  would  expect  to  be  able  to 
do  with  a  limited  private  type). 


Remember,  object  parameters  are  given  values  by 
assignment,  so  can't  have  limited  private  object 
parameters  (rats!). 

generic 

File :  Text_lo.File_Type; 
procedure  Oops; 


Static  Uses  Not  Allowed 


declare 

generic 

X :  Integer; 

package  StaticJJsesJllegal  is 
type  Length  is  range  1  . .  X; 
type  Precision  is  digits  X; 

N  :  constant  :=  X; 
end  StaticJJsesJllegal; 
package  S  is  new  StaticJJsesJllegal  (3); 

begin 

null; 

end; 


i 


Surprise 


declare 

subtype  Small  is  Integer  range  1..10; 

X  :  Integer  :=  27; 
generic 

S :  in  Small; 
procedure  Gen; 
procedure  Gen  is 
begin 

Put  ("All  OK"); 
end  Gen; 

procedure  P  Is  new  Gen  (X); 

begin 

P; 

end; 

-  will  raise  Constraint_Error  at  time  of  instantiation 
declare 

subtype  Small  is  Integer  range  1  ..10; 

X  :  Integer  :=  27; 
generic 

S  :  In  out  Small; 
procedure  Gen; 
procedure  Gen  Is 
begin 

Put  ("All  OK"); 
end  Gen; 

procedure  P  is  new  Gen  (X); 

begin 

P; 

end; 

--  will  execute  OK  -  in  spite  of  apparent  error 


Different  Integer  Types 


Ada  allows  user  defined  Integer  types: 

type  Dimension  is  range  0  . .  100; 

This  is  really  a  derived  type,  and  therefore  a  distinct 
type  from  type  Standard.lnteger. 

Therefore,  a  utility  that  worked  with  Integers  would 
not  work  with  type  Dimension: 

function  ls_Prime  (P  :  Integer)  return  Boolean; 

D  :  Dimension  :=  27; 

if  ls_Prime  (  D )  then  ...  -  would  not  compile 

One  solution: 

if  ls_Prime  ( Integer  (  D  ) )  then  ...  -  OK 

Generic  solution: 


generic 

type  IntJJke  is  range  <>; 
function  ls_Prime  (  P  :  IntJJke)  return  Boolean; 

function  Prime_Dimension  is  new 

ls_Prime  ( IntJJke  =>  Dimension); 

if  Prime  J)imension  (  P  =>  D)  then  . . .  -OK 
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Other  Numeric  Generic  Parameters 


Similarly,  a  generic  could  manipulate  floating  or 
fixed  point  numeric  objects  of  user-defined  types. 


function  Sqrt  (X  :  Float)  return  Float; 
Would  only  work  with  values  of  type  Float: 


type  Precise  is  digits  9; 

Measurement :  Precise  :=  2.33442_545; 
begin 

Ans  :=  Sqrt  (Measurement);  -  would  not  compile 
Ans  :=  Sqrt  (Float  (Measurement));  ~  OK,  but  ugh 


Better  to  make  Sqrt  generic: 
generic 

type  Precision  is  digits  <>; 
function  Gen_Sqrt  (X  :  Precision)  return  Precision; 


function  Sqrt  is  new  Gen_Sqrt  (Precise); 
M  :=  Sqrt  (Measurement); 

Note  that  you  Don't  say: 


function  Sqrt  is  new  Gen_Sqrt  (9); 


Fixed  Point  Does  Not  Give  an  Alternative 


Recall  that  there  is  no  general  purpose  fixed  point 
type  so  all  fixed  point  types  (except  Duration)  are 
user-defined. 


function  Sqrt  (X  :  No_Global_Fixed_Type) 


So,  fixed  point  routines  must  be  generic  if  not 
in  the  scope  of  the  fixed  point  declarations  they 
will  operate  on: 


generic 

type  Fixed  is  delta  <>; 

function  Gen_Fixed_Sqrt  (F  :  Fixed)  return  Fixed; 


And,  instantiations  would  look  as  you  would  expect: 
type  Fix  is  delta  0.01 ; 

function  Fix_Sqrt  is  new  Gen_Fixed_Sqrt  (Fix); 


Note,  again,  that  the  syntax  of  the  instantiation 
is  not: 

function  Fix_Sqrt  is  new  Gen_Fixed_Sqrt  (0.01); 


Enumeration  Types  Can  Also  Be  Passed 


If  a  generic  needs  to  know  about  an  enumeration 
type,  there  is  a  generic  formal  parameter  for 
any  discrete  type. 


Note  that  integer  types  are  also  considered  discrete 
types,  so  an  instantiation  can  pass  either  an 
enumeration  type  or  an  integer  type. 


generic 

type  Things  is  (<>); 

function  Number_Of_Things  return  Integer; 

function  Number_Of_Things  return  Integer  is 
begin 

return 

Things'Pos  (Things'Last)  - 
Things'Pos  (Things'First)  +  1 ; 
end  Number_Of_Things; 


function  Two  is  new 

Number_Of_Things  (Boolean); 

function  Look__Out  is  new 

Number_Of_Things  (Integer); 

function  Barely_Make_lt  is  new 

Number_Of_Things  (Positive); 
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Review  of  Simple  Parameters 


To  Dass 

Use  the  form 

Integer 

type  Int  is  range  <>; 

Floating 

type  Fit  is  digits  <>; 

Fixed 

type  Fix  is  delta  <>; 

Discrete 

type  Enum  is  (<>); 

(integers  are  also  discrete) 
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Access  Type  Parameters 


generic 

type  lnt_Ptr  is  access  Integer; 
package  Probably_Not_Too_Useful  is  . . . 


When  one  parameter  depends  on  another: 

package  Access_Example  is 

type  Candy  is  (MM,  Mars,  Hershey); 
type  Pointer  is  access  Candy; 

generic 

type  Blind  is  limited  private; 
type  Ptr  is  access  Blind; 
package  Lists  is 

type  List  is  limited  private; 

--  must  be  limited  Why? 

procedure  Make  (L  :  in  out  List); 

M  etc.  ... 
private 

type  List  is 
record 

Data  :  Blind;  --  because  of  this 
Link  :  Ptr; 
end  record; 

end  Lists; 

package  Candy _Chain  is  new  Lists 

(Blind  =>  Candy, 

Ptr  =>  Pointer 

); 

end  Access_Example; 
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Structured  Types 


How  do  you  pass  an  array  to  a  generic? 


generic 

type  Arr  is  private; 
Obj :  Arr; 
procedure  Try; 


S  :  String  (1  . .  5)  :=  "kitty"; 
procedure  Nice_Try  is  new  Try  (String,  S); 


procedure  Try  is 
begin 

Obj  ( 1  )  :=  'w'; 
end  Try; 


Sorry  -  no  dice 


To  be  treated  as  an  an  array,  the  structure  of  an  object 
must  be  "known"  to  the  generic: 
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How  To  Teach  Your  Generic  About  Arrays 


generic 

type  lnt_Array  is  array 

(Integer  range  <>)  of  Integer; 
procedure  Sort_Array  (Arr :  in  out  lnt_Array); 

procedure  Sort_Array  (Arr :  in  out  lnt_Array)  is 
Temp :  Integer; 
begin 

for  I  in  Arr'First  +  1  . .  Arr’Last  loop 
for  J  in  Arr'First . .  I  - 1  loop 
if  Arr  (I)  <  Arr  (J)  then 
Temp  :=  Arr  (J); 

Arr  (J)  :=  Arr  (I); 

Arr  (I)  :=  Temp; 
end  if; 
end  loop; 
end  loop; 
end  Sort_Array; 

type  List  is  array  (Integer  range  <>)  of  Integer; 

procedure  S  is  new  Sort_Array  (List); 

L  :  List  (1..5)  :=  (3,  2,  4,  7,  -3); 

begin 

S(L); 


Here,  the  component  type  had  to  be  Integer,  and  the 
index  range  had  to  be  an  unconstrained  range  of 
Integer. 
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More  Flexibility  Possible 


Above,  the  index  type  was  Integer  and  the 
component  type  was  type  Integer. 

Here,  the  index  type  is  a  range  of  any  integer  type 
and  the  component  type  is  also  any  integer  type. 


generic 

type  Index  is  range  <>; 
type  Component  is  range  <>; 
type  lnt_Array  is  array  (Index)  of  Component; 
procedure  Sort_Array  (Arr :  in  out  Int_Array); 
procedure  Sort_Array  (Arr :  in  out  lnt_Array)  is 
Temp  :  Component; 
begin 

for  I  in  Arr'First  +  1  . .  Arr’Last  loop 
for  J  in  Arr'First . .  I  - 1  loop 
if  Arr  (I)  <  Arr  (J)  then 
Temp  :=  Arr  (J); 

Arr  (J)  :=  Arr  (I); 

Arr  (I)  :=  Tdmp; 
end  if; 
end  loop; 
end  loop; 
end  Sort_Array; 
type  Short  is  range  1. .  5; 
type  Dimension  is  new  Integer  range  0  . .  100; 
type  List  is  array  (Short)  of  Dimension; 
procedure  S  is  new  Sort_Array 

(Short,  Dimension,  List); 

L  :  List  :=  (2,  5,  4,  6,  -3); 
begin 
S  (  L ) ; 
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Even  More  Flexibility 


An  array  must  be  indexed  by  a  discrete  type,  but  not 
necessarily  an  integer  type  -  an  enumerated  type 
is  also  OK. 

Also,  the  component  type  can  be  anything  (but  if 
assignment  is  needed  in  the  generic,  then  it  cannot 
be  limited). 


generic 

type  Index  is  (  <>  ); 
type  Component  is  private; 
type  lnt_Array  is  array  (Index)  of  Component; 
procedure  Sort_Array  (Arr :  in  out  lnt_Array); 

procedure  Sort_Array  (Arr :  in  out  lnt_Array)  is 
Temp :  Component; 
begin 

for  1  in  Index'Succ  (Arr'First) . .  Arr'Last  loop 
for  J  in  Arr’First . .  Index'Pred  (I)  loop 
if  Arr  (I)  <  Arr  (J)  then 
Temp  :=  Arr  (J); 

Arr  (J)  :=  Arr  (I); 

Arr  (I)  :=  Temp; 
end  if; 
end  loop; 
end  loop; 
end  Sort_Array; 

type  List  is  array  (Boolean)  of  Float; 
procedure  S  is  new  Sort_Array 

(Boolean,  Float,  List); 

L  :  List  (4.5,  2.6945); 
begin 
S(L); 
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Constrained  vs.  Unconstrainted  Arrays 


Note  that  the  first  example  used  an  unconstrained  type 
for  the  formal  array  parameter  and  was  instantiated 
with  an  unconstrained  actual  array  type. 


The  next  two  examples  showed  a  constrained  array 
type  parameter  and  actual  type. 


There  is  NO  array  parameter  to  generics  that  allows 
either  an  unconstrained  or  constrained  array  type 
to  be  passed  to  it. 


Typically,  if  you  would  like  to  allow  either,  make  the 
generic  handle  unconstrained  arrays,  and  make  the  user 
declare  constrained  array  types  based  on  named 
unconstrained  types,  which  are  the  ones  used  for  the 
instantiation. 


type  Short  is  range  1  . .  5; 
type  List  is  array  (Short)  of  Things; 

The  above  is  really  shorthand  for 

type  Anon  is  new  Integer;  --  or  other  parent  type 
subtype  Short  is  Anon  range  1  . .  5; 

type  AnonJJst  is  array  (Anon  range  <>)  of  Things; 
subtype  List  is  Anon_List  (Short); 

So,  just  don’t  take  shortcuts  In  declaring  the  user 
array  types. 
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No  Generic  Record  Types 


Would  be  nice,  but  the  syntax  and  rules  would  have 
to  be  quite  complex. 


For  example, 
generic 

type  First_Component  is  private; 
type  Second_Component  is  private; 
type  Rec  is  record 

Namel  :  First_Component; 
Name2 :  Second_Component; 
end  record; 
procedure  Nice_Try; 


How  would  you  handle  different  sized  record  structures? 


How  would  you  handle  initialized  components? 


What  would  you  do  with  such  general  records  once 
they  were  passed  to  the  generic? 


Food  for  thought . . . 
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Exceptions  Raised  by  the  Instance 


Exceptions  can  be  raised  and  propagated  by  an  instance 
during  processing. 


These  must  be  handled  by  the  user  of  the  instance: 


generic 

procedure  Action; 

procedure  Action  is 
Error :  exception; 

begin 

•  •  • 

end  Action; 

procedure  Actl  is  new  Action; 
procedure  Act2  is  new  Action; 
procedure  Act3  is  new  Action; 


begin 


Actl; 

Act2; 

Act3; 


exception 

when  Actl. Error  => 
when  Act2.Error  => 
when  Act3.Error  => 
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No  Exception  Parameters  To  a  Generic 


Can’t  pass  an  exception  to  a  generic  to  be  raised: 


generic 

When_Troubie  :  exception;  --  nope 

■  *  9 

procedure  Sort . . . 

•  «  • 

exception 

when  others  => 

raise  When_Trouble; 

end  Sort; 


My_Exception  :  exception; 
procedure  S  is  new  Sort  (My_Exception); 


begin 

S; 

exception 

when  My_Exception  =>  -  this  isn't  possible 
whatever. . . 

end; 
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But,  There  Is  Something  Just  As  Useful 


Passing  a  subprogram  to  a  generic  is  possible: 


generic 

with  procedure  Call_Me_Sometime; 
procedure  General_Stuff; 

procedure  General_Stuff  is 
begin 


Call_Me_So  meti  me ; 

•  •  ■ 

end  General_Stuff; 

procedure  Wait_For_Call  is 
begin 

Put  ("I’ve  been  called!"); 
end  Wait_For_Call; 

procedure  Myjnstance  is  new 

General_Stuff  (Wait_For_Call); 


begin 

Myjnstance; 

-  Wait_For_Call  could  now  be  called 

-  by  the  instance 
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Subprogram  Parameters 


Replaces  the  dynamic  passing  of  subprograms 
such  as  in  standard  Pascal. 

Enables  more  complete  type  checking,  i.e.,  types 
of  parameters  to  passed  subprogram  can  be 
checked  against  calls  to  it. 


Pascal  problem: 

program  P; 
type 

Color  s  (Red,  Green,  Blue); 
var 

Bucket :  Color; 

procedure  Print  (C  :  Color); 
begin 

case  C  of 

Red  :  write  (’Red’); 

Green  :  write  ('Green'); 

Blue :  write  ('Blue'); 

end; 

end; 

procedure  Proc  (P  :  procedure): 
begin 

P  (Bucket);  (*OK*) ' 

P  (5);  (*  runtime  error  *) 

end; 

begin 


Proc  (Print); 


Ada  Solution 


declare 

type  Color  is  (Red,  Green,  Blue); 

Bucket :  Color  :=  Green; 

procedure  Print  (C  :  Color)  is 
begin 

TextJo.Put  (Color'lmage  (C)); 
end  Print; 

generic 

with  procedure  P  (Val  :  Color); 
procedure  Gen_Proc; 

procedure  Gen_Proc  is 
begin 

P  (Bucket);  -OK 

P  (5);  -  compile  time  error 

end  Gen_Proc; 

procedure  Proc  is  new  Gen_Proc  (Print); 


begin 

Proc; 

end; 
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Sending  the  Parameter  Types,  Too 

One  of  the  most  common  uses  of  subprogram  parameters 
to  generics  Is  to  provide  the  generic  with  operation*  on 
user-supplied  types. 

Some  operations  are  Implied  by  the  generic  formal 
parameter: 

type  T  is  private; 

allows  values  of  this  type  to  be  assigned 
to  variables  and  compared  for  equality 


type  T  is  (<>); 

matches  any  discrete  type 

allows  use  of  'First,  'Last,  'Succ,  ’Pred,  'Image, 

’Value,  'Pos,  'Val,  as  well  as  above. 


type  T  is  range  <>; 

matches  any  integer  type 

since  integer  types  are  also  discrete  types, 

allows  all  of  the  above  plus  the  integer  operations 

such  as  etc. 

type  Ar  is  array  (Index)  of  Component; 

allows  indexing,  slicing,  assigning,  equating 
(which  are  special  for  arrays),  'Length,  'First, 

'Last,  etc. 


When  Additional  Operations  are  Needed 


For  example,  with  array,  private,  and  limited  private 
types,  the  generic  cannot  perform  text  output  of  values 
without  help  from  the  user: 


type  Handle  is  access  Integer; 

Ptr :  Handle  :=  new  lnteger'(57); 

function  Handlejmage  (L  :  Handle)  return  String  is 
begin 

return  Integer'lmage  (L.all); 
end  Handlejmage; 

generic 

type  Any  is  limited  private; 
with  function  String_Of  (X  :  Any)  return  String; 
procedure  Gen_Proc  (Obj :  Any); 

procedure  Gen_Proc  (Obj  :  Any)  is 
begin 

Put  ("This  is  Gen_Proc  processing  ..."); 

Put  (String_Of  (  Obj ) ); 
end  Gen__Proc; 

procedure  Example  Is  new  Gen_Proc 

(Handle,  Handlejmage); 

procedure  Interesting  is  new  Gen_Proc 

(Integer,  Integer'lmage); 


begin 

Example  (Ptr); 
Interesting  (75); 


end; 


Default  Subprogram  "Values" 


As  with  generic  object  and  value  parameters  (and  unlike 
generic  type  parameters  -  why?)  generic  subprogram 
parameters  can  be  supplied  by  defaults. 

For  example,  consider  the  following: 

with  Text  Jo; 
package  Shell  is 

generic 

type  Any  is  limited  private; 
with  procedure  Print  (Val  :  Any)  ; 
package  AnyJJsts  is 

type  AnyJJst  is  . . . 

procedure  Put  (L  :  AnyJJst); 

-  the  body  would  call  the  generic 
--  parameter  Print  procedure 
end  AnyJJsts; 

package  CharJJsts  is  new  AnyJJsts 

(Character,  TextJo.Put); 


end  Shell; 


With  judicious  naming  of  the  generic  subprogram 
parameter,  a  default  might  be  possible: 


with  Textjo; 
package  Shell  Is 

generic 

type  Any  is  limited  private; 
with  procedure  Put  (Val :  Any)  is  <>; 
package  AnyJJsts  is 

type  AnyJJst  is  . . . 

procedure  Put  (L  :  AnyJJst); 

-  the  body  would  call  the  generic 
--  parameter  Put  procedure 
end  AnyJJsts; 

package  Char_Lists  is  new  AnyJJsts 

(Character); 

-  what’s  missing? 


end  Shell; 


Remember  -  the  resolution  of  the  default  takes  place  at 
the  point  of  Instantiation  (not  at  the  generic 
declaration).  Otherwise,  it  would  be  trivial. 
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Speaking  of  Point  of  Declaration  vs.  Instantiation... 


Also  remember  that  global  references  from  within  a 
generic  refer  to  those  at  the  point  of  declaration  not 
those  at  the  point  of  instantiation.  But,  default 
references  refer  to  matching  names  from  the  point  of 
instantiation.  Confused? 


with  Text  Jo; 
use  Text  Jo; 
package  Shell  is 

Global  :  Integer  :=  17; 

generic 

with  procedure  Put  (Val  :  Integer)  is  <>; 
procedure  Demo; 

end  Shell; 


package  body  Shell  is 

procedure  Demo  is 
begin 

Put  (Global); 
end  Demo; 

end  Shell; 
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I 


with  Shell; 
package  Inner  is 

Global  :  Integer  :=  39; 

procedure  Put  (I :  Integer); 

procedure  User  is  new  Demo; 
end  Inner; 


with  Textlo; 
package  body  Inner  is 

procedure  Put  (I :  Integer)  is 
begin 

TextJo.Put 

("Surprise!"  &  Integer'lmage  (I)); 

end  Put; 
end  Inner; 


Inner.User; 


What  gets  printed? 


So,  generic  instantiation  is  not  simple  text  substitution. 


> 


6 


Exercise 


Modify  the  Sorting  example  from  before  so  that  the  user 
can  optionally  change  whether  the  sort  is  ascending  or 
descending. 

As  before: 


generic 

type  lnt_Array  is  array 

(Integer  range  <>)  of  Integer; 
procedure  Sort_Array  (Arr :  in  out  lnt_Array); 

procedure  Sort_Array  (Arr :  in  out  Int  Array)  is 
Temp  :  Integer; 
begin 

for  I  in  Arr'First  + 1  . .  Arr'Last  loop 
for  J  in  Arr'First . .  I  - 1  loop 
if  Arr  (I)  <  Arr  (J)  then 
Temp  :=  Arr  (J); 

Arr  (J)  :=  Arr  (I); 

Arr  (I)  :=  Temp; 
end  if; 
end  loop; 
end  loop; 
end  Sort_Array; 


Make  minimal  changes  to  satisfy  requirement. 
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Solution 


generic 

type  lnt_Array  is  array 

(Integer  range  <>)  of  Integer; 
with  function  "<"  (Left,  Right :  Integer) 

return  Boolean  is  <> 

procedure  Sort_Array  (Arr :  in  out  lnt_Array); 

procedure  Sort_Array  (Arr :  in  out  lnt_Array)  is 
Temp :  Integer; 
begin 

for  I  in  Arr'First  +  1  . .  Arr'Last  loop 
for  J  in  Arr'First . .  I  - 1  loop 
if  Arr  (I)  <  Arr  (J)  then 
Temp  :=  Arr  (J); 

Arr  (J)  :=  Arr  (I); 

Arr  (I)  :=  Temp; 
end  if; 
end  loop; 
end  loop; 
end  Sort_Array; 

Instances  could  be  declared: 

type  List  is  array  (Integer  range  <>)  of  Integer; 

procedure  Ascendingl  is  new  Sort_Array 

(List,  "<"); 

procedure  Ascending2  is  new  Sort_Array  (List); 

procedure  Descending  is  new  Sort_Array 

(List,  ">"); 
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Nesting  of  Generics 


It  can  be  useful  to  export  a  generic  utility  from  a 
generic  package.  Don't  clutch: 


generic 

type  Element  is  private; 

with  function  "<"  (Left,  Right :  Element) 

return  Boolean  is  <>; 
package  Sorted_Binary_Trees  is 
type  Tree  is  private; 

procedure  Insert 

(X  :  Element;  Into  :  in  out  Tree); 

generic 

with  procedure  Operate  (X  :  Element); 
procedure  Search_And_Operate  (T  :  Tree); 

end  SortedB  I  nary  T rees ; 


(The  body  is,  of  course,  "trivially  obvious  to  even  the 
most  casual  reader". . .) 


Exercise:  Give  an  example  instantiation  of  the  above 
generics.  (Not  the  body.) 


i 


A  Simple  Solution 


package  lnt_Trees  is 

new  Sorted_Blnary_Trees  (Integer); 

procedure  Putjnt  (X  :  Integer)  is 
begin 

Text  Jo.  Put  ( Integer’lmage  (X) ); 
end  Putjnt; 

procedure  PrintJn_Order  is  new 

Int  Trees.Search_And_Operate  (Putjnt); 
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Other  Type  Parameters 


As  with  arrays,  unconstrained  types  are  allowed  for 
private  and  limited  types  using  the  customary  syntax: 


generic 

type  Furniture  (Upholstered  :  Boolean) 

is  private; 

package  P  is 

Table :  Furniture  (False); 

Couch  :  Furniture  (True); 
end  P; 


Note  that  a  default  for  the  discriminant  is  Not  allowed. 


This  means  that  an  unconstrained  object  cannot 

be  declared  (unlike  typical  discriminated  records) 


Incidentally,  a  type  mark  must  be  used  in  a  generic 
part,  and  not  a  subtype: 


generic 

subtype  Short  is  Integer  range  <>; 
procedure  Not_A_Chance; 
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More  on  Unconstrained  Types 


Peculiar  situations  can  arise  when  matching  a  private  or 
limited  type  with  an  actual  type  which  is  unconstrained. 


If  the  actual  type  is  unconstrained: 

an  unconstrained  array 
an  unconstrained  record  without  a  default 
discriminant 


then  you  can't  declare  an  object  of  that  type  inside  the 
generic  (which  includes  allocators  without  initial  values) 


unless  the  object  is  a  constant,  meaning  the  initial  value 
must  have  been  supplied  by  the  instantiation. 


generic 

type  T  is  private; 
package  Experiment  is 
Val :  T; 

type  Ptr  is  access  T; 
P  :  Ptr  :=  new  T ; 
end  Experiment; 


type  Boo  is  array  (Boolean  range  <>)  of  Integer; 
package  P  is  new  Experiment  (Boo);  -  will  fail 

type  Rec  (B  :  Boolean)  is  record 
null; 

end  record; 

package  Q  is  new  Experiment  (Rec);  -  will  fail 


generic 

type  T  is  private; 

Init :  T; 

package  Experiment  is 

Val :  T  :=  Init;  -  still  a  problem 

type  Ptr  is  access  T; 

P  :  Ptr  :=  new  T(lnlt);  -  this  helps 

end  Experiment; 

type  Boo  is  array  (Boolean  range  <>)  of  Integer; 

I :  Boo  (False  . .  True)  :=  (6, 12); 

package  P  is  new  Experiment  (Boo,  I);  -  will  fail 

type  Rec  (B  :  Boolean)  is  record 
null; 

end  record; 

R  :  Rec  (False)  :=  Rec'(B  =>  False); 

package  Q  is  new  Experiment  (Rec,  R);  --  will  fail 


generic 

type  T  Is  private; 

Inlt :  T; 

package  Experiment  is 

Val  :  constant  T  :=  Init;  -  OK 

type  Ptr  is  access  T ; 

P  :  Ptr  :=  new  T'(lnit); 
end  Experiment; 


type  Boo  is  array  (Boolean  range  <>)  of  Integer; 

I :  Boo  (False  . .  True)  :=  (6, 12); 

package  P  is  new  Experiment  (Boo,  I);  -  OK 


type  Rec  (B  :  Boolean)  is  record 
null; 

end  record; 

R  :  Rec  (False)  :=  Rec'(B  =>  False); 
package  Q  is  new  Experiment  (Rec,  R);  -  OK 


Retrofitting  Generics 


Look  familiar? 

package  Counter  is 

type  Count  is  limited  private; 
procedure  Increment  (C  :  in  out  Count); 
procedure  Reset  (C  :  out  Count); 
private . . . 
end  Counter; 

package  Trees  is 

type  Tree  is  limited  private; 
procedure  Get  (T  :  out  Tree); 
function  ls_Leaf  (T  :  Tree)  return  Boolean; 
procedure  Split  (T  :  in  out  Tree; 

Left,  Right :  out  Tree); 
procedure  Return  (T  :  in  out  Tree); 
private . . . 
end  Trees; 

with  Trees; 
package  Piles  is 

type  Pile  is  limited  private; 

function  Empty  (P  :  Pile)  return  Boolean; 

procedure  Put  (T  :  in  out  Trees.Tree; 

On  :  In  out  Pile); 

procedure  Initialize  (P  :  in  out  Pile); 
procedure  Get  (T  :  out  Trees.Tree; 

From  :  in  out  Pile); 

private . . . 
end  Piles; 

with  Trees,  Piles,  Counter; 
procedure  Count_Leaves  is  . . . 


Generalization 


generic 

type  Object  is  limited  private; 
package  General_Piles  is 

type  Pile  is  limited  private; 

function  Empty  (P  :  Pile)  return  Boolean; 

procedure  Put  (T  :  in  out  Object; 

On  :  in  out  Pile); 

procedure  Initialize  (P  :  in  out  Pile); 
procedure  Get  (T  :  out  Object; 

From  :  in  out  Pile); 

private . . . 
end  Piles; 

-  package  Is  the  same  except  for  substitution 

-  of  Object  for  Trees.Tree 


with  Trees,  General_Piles,  Counter; 
procedure  Count_Leaves  is  . . . 
package  Tree_Piles  is 

new  General_Piles  (Trees.Tree); 

■  •  ■ 

-  can  be  the  same  otherwise 

Note  that  this  generalization  was  made  easy  due  to  the 
lack  of  assumptions  that  the  original  components  made 
about  each  other's  types. 

Clue:  private  and  limited  private  types  assist  in  future 
generalizations  of  your  program  components. 
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What  if  the  types  aren't  private? 


Generalizations  are  still  possible,  but  require  more 
complicated  generic  parts. 


package  Export_Array  is 

type  Global_Array  is  array  (1.  .10)  of  Integer; 


with  Export_Array; 

package  Needs_To_See_Global_Array  is 
procedure  Sort 

(Ar :  in  out  Export_Array.Global_Array); 


To  generalize  the  above: 
generic 

type  GA  is  array  (1..10)  of  Integer; 
package  Needs_To_See_Global_Array  is 
procedure  Sort  (Ar :  in  out  GA); 


Or  better  would  be: 
generic 

type  lndex_Range  is  range  <>; 
type  GA  is  array  (lndex_Range)  of  Integer; 
package  Needs_To_See  . . . 

But  would  need  to  ensure  that  the  body  of  the  package 
did  not  depend  on  literals  unique  to  the  original  array 
type  (i.eM  that  the  range  went  from  1  to  10). 
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Simple  Generic 


Given  a  single  state-machine  implementation  of  stacks, 
the  customary  way  to  introduce  many  stacks  is  to  turn 
it  Into  an  abstract  data  type: 

Simple  stack  package: 

package  Stack  Is 

procedure  Push  (I :  Integer); 
procedure  Pop  (I :  out  Integer); 
function  Empty  return  Boolean; 
function  Full  return  Boolean; 
end  Stack; 


Conventional  way  to  convert  to  many  stacks: 

package  Stacks  is 

type  Stack  is  private; 

procedure  Push  (I :  Integer;  On  :  in  out  Stack); 
procedure  Pop 

(I :  out  Integer;  From  :  In  out  Stack); 
function  Empty  (S  :  Stack)  return  Boolean; 
function  Full  (S  :  Stack)  return  Boolean; 
private . . . 
end  Stacks; 

User  code: 

S  :  Stacks.Stack; 

I :  Integer; 
begin 

Push  (25,  S); 

Pop  (I,  S); 
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Many  Stacks,  "Generlcally" 


Review  the  original  single  stack: 

package  Stack  Is 

procedure  Push  (I :  Integer); 
procedure  Pop  (I :  out  Integer); 
function  Empty  return  Boolean; 
function  Full  return  Boolean; 
end  Stack; 


Illustration  of  generic  method  (not  necessarily 
recommended,  just  for  example): 

generic 

package  Stack  is 

procedure  Push  (I :  Integer); 
procedure  Pop  (I :  out  Integer); 
function  Empty  return  Boolean; 
function  Full  return  Boolean; 
end  Stack; 

No  change  to  the  body  in  this  conversion!  (Unlike  the 
body  of  the  private  type  example.) 

User  code: 

package  SI  Is  new  Stack; 
package  S2  Is  new  Stack; 

I :  Integer; 
begin 

SI. Push  (25); 

SI  .Pop  (I); 
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Generic  Implementations 


What  happens  when  a  generic  Is  elaborated? 

What  happens  when  an  Instantiation  is  elaborated? 


It  depends  . . . 


Suppose  an  initialization  block  appears  at  the  end  of  a 
generic  package  body: 

with  Text  Jo; 
package  body  Stack  is 
*  ■  * 

begin 

TextJo.Put  (’’Stack  Instance  elaborated”); 
end  Stack; 

Then,  each  of  the  following  will  cause  the  above  Put 
statement  to  execute: 

package  SI  is  new  Stack; 
package  S2  is  new  Stack; 


In  the  case  of  packages  (not  generics)  there  would  only 
be  one  logical  package  and  only  one  elaboration 
initialization  would  occur. 


This  emphasizes  the  fact  that  there  are  as  many  logical 
packages  (or  subprograms)  as  there  are  Instantiations 
of  a  generic  package  (or  subprogram). 
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Logical  or  Physical? 


Debate  over  whether  an  Implementation  should  actually 
create  physical  copies  of  a  generic  for  each  instance  or 
somehow  "code  share"  among  all  the  Instances. 


p  Code  sharing  Is  more  the  way  a  procedure  or  function 

I  behaves  (re-entrant). 


Physical  expansion  (cody  copying)  is  more  the  way  a 
macro  expansion  behaves. 


There  are  advantages  and  disadvantages  of  each: 


Physical  Expansion,  Pro: 

Object  code  executes  faster  because  all  the  work 
is  done  at  compile  time  and  no  context  switching  is 
needed  among  the  instances  of  the  same  generic  code. 

Implementation  is  simpler. 


Physical  Expansion,  Con: 

Space  requirements  for  object  code  can  become  a 
real  problem  if  there  a  lot  of  instances. 

Recompilation  of  a  generic  spec  Is  always  required 
even  if  just  the  body  changes.  (Why?) 
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Code  Sharing,  Pro: 

Significant  savings  in  object  code  size. 

Generic  bodies  can  be  changed  without  recompiling 
the  specs  (and  therefore  the  instantiations). 

Code  Sharing,  Con: 

Execution  can  be  slower  due  to  run  time 
instantiations. 

Implementation  is  more  difficult. 

So,  which  is  it?  There  is  a  "best"  answer: 


For  a  development  compiler,  on  a  host  machine,  where 
maintenance,  modification,  and  recompilation  is  likely 
and  turnaround  time  Is  more  important  that  saving  a 
few  milliseconds  at  run  time,  you  want  a  code  sharing 
compiler. 

For  a  target  compiler,  In  a  time-critical  application, 
where  execution  efficiency  Is  more  Important  that 
recompilation  efficiency,  you  want  a  code  copying 
compiler. 

It's  11 :00  . . .  Do  you  know  what  your  compiler  is 
doing? 

(Do  you  know  what  the  different  vendors  offer?) 
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More  Retrofitting  -  Make  the  following  general: 

package  Project  is 

subtype  Line  is  String  (1..80); 
subtype  Word  is  String  (1..80); 
type  Break_Chars  is  (' 
end  Project; 

with  Project;  use  Project; 

procedure  NextWord  (From  :  in  out  Line;  Into  :  out  Word)  is 
begin 

Into  :=  (others  =>  '  '); 
for  C  in  1  ..  80  loop 

-  find  first  non-Break_Chars  letter  in  From 
end  loop; 

for  W  in  C  ..  80  loop 

-  copy  contiguous  non-Break_Chars  to  Into 
end  loop; 

for  R  in  W+1  ..  80  loop 

-  left  justify  remaining  letters  in  From 

-  and  set  rest  to  a  Blank 
end  loop; 

end  Next_Word; 

with  Next_Word; 
with  Project;  use  Project; 
with  Textjo; 
procedure  Main  is 

lnput_Line  :  Line; 

Length  :  Natural; 

A_Word :  Word; 

begin  ...  -  initializations,  file  openings 
while  not  Text_lo.End_Of_File  (ln_File)  loop 
lnput_Line  :=  (others  =>  '  ’); 

Get J-ine  (ln_File,  lnput_Line,  Length); 
loop 

Next_Word  (From  =>  lnput_Line,  Into  =>  A_Word); 
exit  when  A_Word  =  (others  =>  ' '); 

Put_Line  (A_Word); 
end  loop; 
end  loop; 
end  Main; 
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package  Project  is 

subtype  Line  is  String  (1..80); 
subtype  Word  is  String  (1..80); 
type  Break_Chars  is  (’  \ 
end  Project; 

generic 

type  Line  is  array  (Positive  range  <>)  of  Character; 
type  Word  is  array  (Positive  range  <>)  of  Character; 
Break_Chars  :  String; 
package  Next_Word_Package  is 
procedure  Next_Word 

(From  :  in  out  Line;  Into  :  out  Word); 
end  Next_Word_Package; 

package  body  Next_Word_Package  is 
procedure  Next_Word 

(From  :  in  out  Line;  Into  :  out  Word)  is 

begin 

Into  :=  (others  =>  Break_Chars  (BreakChars'First)); 


with  Next_Word; 
with  Project;  use  Project; 
with  Text  Jo; 
procedure  Main  is 

InputJJne :  Line; 

Length  :  Natural; 

A_Word  :  Word; 
package  Words  is  new 
••• 

begin  ...  -  initializations,  file  openings 
while  not  TextJo.End_Of_File  (ln_File)  loop 
InputJJne  :=  (others  =>  ’ '); 

Get  JJne  (ln_File,  InputJJne,  Leng*h); 
loop 

Next_Word  (From  =>  lnput_Line,  Into  =>  A_Word); 
exit  when  A_Word  =  (others  =>  ' '); 

PutJJne  (A_Word); 
end  loop; 
end  loop; 
end  Main; 
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Unwrapping  Ada®  Packages 


LCDR  Melinda  Moran 
Computer  Science  Department 
U.  S.  Naval  Academy 
Annapolis,  MD  21401 
(301)  267-2797 
AV  281-2797 
LINDYeUSNA 


Ada®  is  a  registered  trademark  of  the  U  S  Government  Ada  Joint  Program  Office 


Ada  Program  Structure 

□  4  Basic  Program  Units: 
^Packages 

□  Subprograms 

□  Tasks 


□  Generic  Units 


Packages,  a  Powerful  Tool  for 
Software  Engineering: 


EfAbstraction 


□  both  data  and  process  abstraction  supported 
D  layers  of  abstraction  supported 
0  facilitate  managing  complexity  by  allowing 
division  of  problem  into  layers  of  abstraction 
.  with  7  +/-  2  components  each 
Bmformation  Hiding 


□  irrelevant  information  hidden 

□  only  information  relevant  to  each  level  of 
abstraction  is  visible  and  accessible  at  that 


/  level 

□  Modularity 

□  facilitate  creation  of  libraries  of 
software  modules  which  can  be  reused 
to  implement  many  systems 

□  facilitate  easily  modified  systems  where 
packages  can  easily  be  added  and  subtracted 

ETLocalization 


□  facilitate  creation  of  very  cohesive  packages 
which  can  be  less  tightly  coupled 

□  Uniformity 

□  Completeness 

Q^Confirmability 

0  communication  only  through  visible 
interface  minimizes  debugging' problems 
by  minimizing  ’ripple’  effects 

□  clear  definition  of  interfaces  simplifies 
testing  problems 


PACKAGES 


Definition:  collection  of  computational 
resources,  which  may  encapsulate  data 
types,  data  objects,  subprograms,  tasks 
and  even  other  packages. 


Purpose:  to  express  and  enforce  user’s 
logical  abstractions  within  the  language. 


Applications/Common  Usages: 

□  Encapsulate  related  data  types,  constants  or 
objects. 

□  Encapsulate  related  program  units. 

□  Embody  an  Abstract  Data  Type. 

□  Embody  an  Abstract -state  Machine. 

□  Encapsulate  tasks  * 


Dnfo  taken  from  Software  Engineering  with  Ada  by  Grady  Booch 
with  exception  of  *] 


Structure  of  a  Package 

□  Composed  of  2  parts 

□  Specification 

□  defines  the  packages  Interface  with  client 
modules—  the  types  end  services  if  offers 

□  defines  the  portion  of  the  package  Visible’ 
to  other  modules 

□  must  be  compiled  before  program  units 
which  use  it 

□  may  contain  a  "private’  portion 

□  Body 

□  contains  implementation  details  of  "how* 
the  package  fulfills  its  contract  with  the 
client  modules 

□  facilitates  Information  hiding*  —  hides 
irrelevant  informaton  from  client 
modules 

□  protects  data  structures  and  operations 
it  encapsulates  from  inadvertent  or 
malicious  tampering  by  client  module 

□  may  be  separately  compiled  at  a  later 
time  than  specification 

□  may  be  replaced  with  different 
implementation  without  recompflaiton 
‘ripples’ tooths  modules  as  long  as 
specification  la  unchanged 

□  may  not  be  present  tf  specification  only 
contains  types  or  object  declarations 

□  may  contain  a  section  of  initialization 
statements  and  an  exception  handler 
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—  Unit  Names 

—  Author: 

—  Oates 

—  Functions 


Basic  10 
LCDR  MORAN 
4  AUG  1987 

Provides  user  ability  to  do 
character>  string,  integer, 
data  types. 


input  and  output  of 
and  floating  point 


package  Basic_I0  Is 
procedure  Neu_LineS 

—  advances  cursor  to  next  line  on  the  screen 


procedure  Getdtea  s  out  character)  ) 

—  reads  a  single  character  froa  the  keyboard 

procedure  Get_L ine < Item  s  out  character) ; 

—  reads  a  single  character  and  carriage  return  froe  the  keyboard 

procedure  Putdtea  s  in  character)  I 

—  outputs  a  single  character  to  the  screen 

procedure  Put_Linedtea  :  in  character)) 

—  outputs  a  single  character  to  the  screen  and  advances  the  cursor 

—  to  the  next  line  on  the  screen 


procedure  Getdtea  ■  out  string)  ) 

--  reads  a  string  of  characters  froa  the  keyboard 

procedure  Get_Linedtea  i  out  string)) 

—  reads  a  string  of  characters  and  a  carriage  return  froa  the  keyboard 

procedure  Putdtea  :  in  string); 

—  outputs  a  string  of  characters  to  the  screen 

procedure  Put_Linedtea  :  in  string)) 

--  outputs  a  string  of  characters  to  the  screen  and  advances  the  cursor 

—  to  the  next  line  on  the  screen 


procedure  Cetdtea  >  out  integer)) 

—  reads  an  integer  froaa  the  keyboard 

procedure  Cet_Line(Itea  I  out  integer)) 

--  reads  an  integer  and  a  carriage  return  froa  the  keyboard 

procedure  Putdtea  l  in  integer); 

--  outputs  an  integer  to  the  screen 

procedure  Put_Linedtea  :  in  Integer)  ) 

—  outputs  an  integer  to  the  screen  and  advances  the  cursor  to  the 

—  next  line  on  the  screen 

procedure  Getdtea  >  out  float); 

—  reads  a  floating  point  value  froa  the  keyboard 

procedure  Get_linedtea  )  out  float); 

—  reads  a  floating  point  value  and  a  carriage  return  from  the  keyboard 

procedure  Putdtea  :  in  float): 

--  outputs  a  floating  point  value  to  the  screen 


procedure  Put_linedtem  :  in  float); 

—  outputs  a  floating  point  value  to  the  screen  and  advances  the  cursor 
--  to  the  next  line  on  the  screen 


end  Basic  IQ) 
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package  COMPLEX  Is 

type  COMPlEX_NUMBER  is  record 

REAL-PART  :  FLOAT, 

IMAGINARY.PART  :  FLOAT, 

end  record; 

function  (A,B  .  in  COMPLEX-NUMBER)  return  COMPLEX-NUMBER; 

function  (A,B  :  in  COMPLEX-NUMBER)  return  COMPLEX-NUMBER, 

end  COMPLEX, 

package  body  COMPLEX  is 

function  (a,B  .  in  COMPLEX-NUMBER)  return  COMPLEX-NUMBER  is 
RESULT  :  C0MPLEX-NUM8ER; 

begin 

RESULT. REAl _ PART  :=  A.REAL.PART  *  B.REAL-PART, 

RESULT. IMAGINARY-PART  :»  A.!MAGINARY_PART  *  B.IMAGINARY-PART, 
return  RESULT , 
end; 

function  (A,B  :  in  COMPLEX-NUMBER)  return  COMPLEX-NUMBER  is 
RESULT  :  COMPLEX-NUMBER, 

begin 

RESULT  REAL-PART  :*  A.REAI _ PART  -  B.REAI _ PART , 

RESULT. IMAGINARY-PART  :=  A. IMAGINARY-PART  -  B.IMAGINARY_PART, 
return  RESULT ; 
end; 

end  COMPLEX; 


®vorSi8fflidfliD]|  coolUiDnsd 


package  FRACTIONS  Is 
type  FRACTION  is  record 

NUMERATOR  :  NATURAL, 

DENOMINATOR  :  NATURAL; 

end  record; 

function  *♦*  (A.B  :  In  FRACTION)  return  FRACTION; 
function  (A,B  :  m  FRACTION)  return  FRACTION; 
end  FRACTIONS, 

package  body  FRACTIONS  Is 

function  (A,B  :  in  FRACTION)  return  FRACTION  is 
RESULT  :  FRACTION, 

begin 

RESULT.NUMERATOR  :«  (A.NUMERATOR  *  B. DENOMINATOR)  * 

(B.NUMERATOR  *  A.DENOMINATOR); 
RESULT . DENOM I N ATOR  A.DENOMINATOR  ♦  B.DENOMINATOR; 
return  RESULT, 
end; 

function  (A,B  :  In  FRACTION)  return  FRACTION  is 
RESULT  :  FRACTION; 

begin 

RESULT.NUMERATOR  ;•  (ENUMERATOR  *  B.DENOMINATOR)  - 

(B.NUMERATOR  *  A.DENOMINATOR); 
RE5ULT.DENOMINATOR  :»  A.DENOMINATOR  ♦  B.DENOMINATOR; 
return  RESULT, 
end; 

end  FRACTIONS, 


OmrlliggitiSsty)  C)BiB&9aQ(B®d 

with  COMPLEX,  FRACTIONS; 
use  COMPLEX,  FRACTIONS; 
procedure  ARITHMETIC  Is 
X  :  FRACTION  (3,4); 

Y  :  FRACTION  (5.6); 

FRACTION_RESULT  :  FRACTION  :«  (1,1); 

A  :  COMPLEX_NUMBER  :»  (5,7); 

B  :  COMPLEX_NUMBER  :•  (8,9); 

C0MPLEX_RE5ULT  :  COMPLEX_NUMBER  :«  (0,0); 

begin 

FRACTION_RE5ULT  :»  X  ♦  Y, 

COMPLEX_RE5ULT  :«  A  ♦  B; 

FRACTION_RESULT  ;»  X  -  Y; 

COMPLEX_RESULT  :=  A  -  B; 

end; 


Packages  with  No  Body 


package  CALENDAR  is 

type  DAY  is  (MONDAY.  TUESDAY,  WEDNESDAY.  THURSDAY.  FRIDAY. 
SATURDAY.  SUNDAY); 

type  MONTH  is  (JANUARY.  FEBRUARY,  MARCH.  APRIL.  MAY.  JUNE. 

JULY.  AUGUST.  SEPTEMBER.  OCTOBER.  NOVEMBER. 
DECEMBER); 

type  YEAr  is  range  0  . .  INTEGER! AST; 
end  CAL;-:*  JAR; 


package  METRIC_EARTH_CONSTANTS  is 
EQUATORIAL_RADIUS  :  constant 6378.145; 

GRA V IT AT10N_C0NST ANT  :  constant 3.9860 1 2e5; 

SPEED-UNIT  :  constant 7.90556828; 

TIME-UNIT  :  constant 806.8 1 1 8744; 

end  METRIC_EARTH_CONSTANTS; 


--km 

— km**3/sec',2 
-km/sec 
—  sec 


1 METR  1C_E A RTH-CONST ANTS  package  taken  from  Software  Engineering 
with  Ada  by  Grady  Boochl 
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vich  TYPES; 
use  TYPES; 

package  GIG I_G RAPH ICS_PKG  is 


procedure  SETSCSEENSCALE( lef t , r igh t ,  top , boc ton  :  in  integer); 
procedure  CLEARSCREEN; 

procedure  SETSCREENCOLOR ( co lor  :  in  colortyp e); 
procedure  SETREVERSEVIDEO ; 
procedure  SETNORMALVIOEO ; 

procedure  FREEZ ESCREEN ( c i ck s  :  in  integer); 
procedure  MOVECURSORABS (xcoord , ycoord  :  in  integer); 
procedure  SETCURSORAT(xcoord , ycoord  :  in  integer); 
procedure  MOV ECURSORREL ( xinc r , y  inc r  :  in  integer); 
procedure  QUERYCURSORPOS ( xcoord , ycoord  :  out  integer); 
procedure  SAV ELASTMOVELOC ; 
procedure  B ES TORELASTMOV ELOC  ; 
procedure  PUTDOT ; 

procedure  DRAWL  I N£TO ( xcoo rd , yc oo r d  :  in  integer); 
procedure  DRAW  POL  YL  III  E  (  c  o  o  r  d  a  r  r  ay  :  in  coordarraytype; 

num_o f _c o o r d_pa i r s  :  in  integer); 
procedure  DRAWCIRCLE ( xcoord  .  ycoord . rad ius  :  in  integer); 
procedure  S ETS HAD  I MC R EFL IN E ( y_v a lu e :  in  integer); 
procedure  S ETS HAD  I  MG CHAR ( s had ing_c ha r  :  in  character); 
procedure  S ETS HAD  IMG  ON  ; 
procedure  S ETSHAD INC  OFF  ; 
procedure  SAVELASTDRAWLOC  ; 
procedure  RESTORELASTDRAWLOC  ; 

procedure  S ETWR IT  INC  COLOR ( co l o r  :  in  colortype); 
procedure  SETWRIT INCMQDE ( node  :  in  oodetype); 
procedure  S ETTEXTS IZ E ( s i ze  :  in  integer); 
procedure  SETTEXTPATH ( ang le  :  in  integer); 
procedure  S ETTEXTH EIG UT ( he igh t  :  in  integer); 
procedure  S ET ITAL ICS AMG L E ( ang L e  :  in  integer); 
procedure  SETBL  II1KOF  F  ; 
procedure  SET3LINKON; 
procedure  SAV ETEXTATTRIB UTES  ; 
procedure  R  ES  TOPvETEXTATTR  I BUTES  ; 
procedure  QUTP'JTi  integer _val  :  in  integer); 
procedure  OUTPUT ( c ext_v a L  :  in  string); 
procedure  OUTPUT(char  _v  al  :  in  character); 
end  GIGI_GRAPHICS_PKG ; 
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with  TEXT_HANDLER ; 
use  TEXT_HAHDL  ER ; 

package  body  G IG I_G RAPH IC S_PKG  is 


—  current  screen  scale  bounds 
CLEFT  :  integer  : “  0; 

C&1GUT  :  integer  :■  767; 

CTOP  :  integer  ;■  0; 

CBOTTOM  :  integer  :*  479; 


current 

current 

current 

current 


-current  cursor  position 
CP_X  :  integer  : ■  0; 

CP_Y :  integer  : ■  0; 


—  current 

—  current 


task  SEMAPHORE  is 
ent  ry  SEIZE  ; 
entry  REL  EAS E ; 
end  SEMAPHORE; 

task  body  SEMAPHORE  is 

IN_USE  :  boolean  :•  false; 
begin 
loop 

select 

when  not  IN_USE  «> 
accept  SEIZE  do 

IN_USE  true; 
end  SEIZE; 
or 

when  I N_U S  E  *> 

accept  RELEASE  do 
IN_USE  :=  false; 
end  REL  EAS E ; 
end  select; 
end  loop  ; 
end  SEMAPHORE; 


left  x-axis  value 
right  x-axis  value 
top  y-axis  value 
bottom  y-axis  value 

position,  x-value 
position,  y-value 
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function  INBOUNDS ( xcoord , ycoord  :  in  integer)  return  boolean  is 
xvalid,  yvalid  :  boolean; 
begin 

—  check  if  xcoord  between  left  and  right  screen  scale  bounds 

if  ((xcoord  >*  cleft)  and  (xcoord  <*  cright))  or 

((xcoord  <■  cleft)  and  (xcoord  >■  cright))  then 

xvalid  : ■  true; 
else 

xvalid  : ■  false; 
end  if  ; 

—  check  if  ycoord  between  top  and  bottom  screen  scale  bounds 

if  ((ycoord  >■  ctop)  and  (ycoord  <m  cbottom))  or 

((ycoord  <■  crop)  and  (ycoord  >■  cbottom))  then 

yvalid  :*  true; 
else 

yvalid  :■  false; 
end  if  ; 

if  (xvalid)  and  (yvalid)  then 
return  true ; 
else 

return  false  ; 
end  if ; 
end  ; 


procedure  CLEARSCREEN  is 
T  :  TEXT; 
begin 

T  TO_TEXT (esc)  4  "Pp"  4  ”S(E)"  4  esc  4  ”\”; 
PUT ( T  )  ; 
end  ; 


procedure  S ETSCREENCOL OR ( co 1  or  :  in  colortype)  i3 
x  :  integer ; 

T  :  text; 
begin 

x  colortype'pos(color) ;  —  x»ordinal  position  of  color  chosen 

—  see  colortype  in  types  package 
T  :*  TO_TEXT ( esc )  4  "Pp”  4  "S(I"  4  integer ' image (x )  4  ")" 

4  esc  4  " \ " ; 

PUT(T  )  ; 
end  ; 


procedure  SETREVERSEV IDEO  is 
T  :  TEXT; 
begin 

T  TO_TEXT (esc)  4  "Pp"  4  "S(N1}"  4  esc  u 
PUT ( T  )  ; 
end  ; 


Specification  Structure 

□  2  Parts 

□  Visible  portion 

□  extends  from  beginning 
of  package  specification 
up  to  word  “private” 

□  Client  modules  can  "see" 
and  use  the  types, 
objects,  subprograms  in 
this  section 

□  Resources  in  this  part 

of  the  spec  are  said  to  be 
"exported" 


□  Private  portion 

□  Part  of  the  specification 
that  follows  the  word 
"private" 

□  Types  declared  in  this 
portion  of  the  spec  can 
be  seen  "  textual  ly"  but 
their  structural 
components  are  not 
accessible  to/corruptible 
by  the  client 

□  Declaration  of  types  as 
private  facilitates  use 
of  abstraction  where 
client  operates  with 
logical  properties  of  the 
type  and  cannot  access 
the  details  of  its  physical 
implementation 

□  Private  types  can  only  be 
declared  in  the  visible 
part  of  a  package;  their 
implementation  is  in  the 
private  part  of  the  package 

□  2  categories  of  private  type 
□  private  types  -  can  use 

operations  declared  in  visible 
part  of  pkg  spec,  assignment 
operator,  eq.  and  inequality  op 
0  limited  private  types-  same 
as  for  private  types  except 
assignment,  eq  and  inequality 
operations  unavailable 


c.**s  I* 


pacxaga  "rac-ions  Is 


type  Fraction  Is 
/••cord 

Nu«erarcr  :  Inreger  ;•  3; 
OenoHl  i  n«Tor  :  positive  ;«  1; 
end  r«3»ra; 


function  Hw«fractton(N, 
—  "creere" 


0:  Integer)  return  Fr action; 


end  FfaC*ionS; 


)icm;i  -re¬ 
type  r~  zcr  zm  Is  :*■  •  -5'“ : 

funCTfOr  'f««»F'-ac~.loni  *f,  0: 

—  "c.-eate" 

function  *u<nar(*:  Fraction) 
function  0enc*(*:  Fraction) 

—  decomposition 

function  ■*"!».  y;  Fraction J 


reger  return  rrac~'on; 


return  Inragar; 
return  fn reger; 


rofurn  Fraction; 


function  Nt*i*r(x;  Fraction) 

return 

integer; 

Integer; 

Crac*l  on; 

function  •-"lx.  y:  Fraction) 

return 

function  0anom(*:  Fraction! 

return 

function  "’"lx,  y:  Fraction) 

return 

—  decompoi 1 tlon 

function  "*"(*,  y:  Fraction) 

rerurn 

function  •/"lx,  y:  Fraction) 

—  ar  t  rn  toe  tic 

return 

function  *-'*(*»  y:  Fraction) 

return 

Fr  JC'Ion; 

function  £au4llx,  y;  Fract'cn) 

return 

function  ****(x,  y:  Fraction) 

rerurn 

cr  action; 

function  •«"lx.  y:  Fractionl 

return 

function  ■/*( *,  y:  Fraction) 

*■*  ar  ( tn  meric 

rarurn 

Fract len; 

function  y:  Fraction) 

—  comparison 

return 

function  Esua  t ( * ,  y:  eract!on) 

return 

Dooi «an; 

function  Seducelx:  Fraction) 

return 

function  y:  Fraction) 

rerurn 

bool een ; 

function  Fract l onTo) ntlx :  Crac*icnl 

return 

function  yt  pracr.on/ 

—  con par 1 san 

return 

boo*  ean ; 

function  1 ntToFract 1 ont I :  n-e-er1 
— -  el  seal laneous 

return 

tucKrrlan  Seo uca(x:  Fraction) 

return 

FraC" I  On ; 

private 

function  Fract ! onTointtx;  Fraction) 

return 

.  nrycer  ; 

type  Frac-icn  is 

function  i  nr  for  r  sc  f  on*  1 :  Integer) 

—  el  see i lentous 

return 

*rx- on; 

record 

nureratcr;  fn-eg*r  :•  3; 

Oeno* I  na tor  :  pOsi*l« 
•no  record; 


•nd  tfrjcrlors; 


Figure  1**  PjCkjye  scarification 


figure  t-'f  P- 


•pev«  vin.i 


pacnag*  body  Fractions  ft 

—  o oca  *cr  *unc"fon  ooqy  “«»«fract:cn 

function  burner  <lx:  Fraction;  rafurn  Integer  Is 
bag  in 

return  «.  Nu.ner  atcr ; 

•nd  V#r; 

—  coat  for  function  soay  Uenaa 

—  coce  for  function  bo  ay 

function  "-•<*,  y:  Fraction)  return  ffrjc*!on  Is 
H;  Integer; 

0:  Positive; 

&•>]  ( n 

N  ;•  Nu«n»r  1  x  )  •^enax**  y )  “  *ur*wr  I  y  *  •Ce^cml  *  ) ; 

Q  .  *  Ownum  *  i  *0«ncnv  y  ) ; 

return  Seduce*  *•« err. ict  I c«*  M.3*  •  ; 

•nd 

—  code  for  function  body  "•• 

~~  code  fzr  function  io<jy  */" 

—  cc  .u  ‘or  function  boay  Secwco 

function  ideal  lx,  y:  Frjc-.'on)  return  bcoieen  Is 
dug  I  n 

return  ‘lumar  *;*0anomt  y»«nuR*n  yi*Cwnon*(*  I ; 
•nd  fquui ; 

—  cod*  ‘or  function  lody  V 

—  coca  ‘or  function  bccv  *>•• 

function  Fr  ict  To.  nrl x r  Fract'cn)  return  Integer  !* 
begin 

rafurn  *<i«ar  I  x  )/C«snon(  x  i  ; 

•nd  frjc*T(jinf; 

function  I  nr  Top  »*4c“  I  I ;  Integer*  return  Fraction  Is 
ba«)  I  n 

ro  tur  n»  f ,  ’  •  ; 

•nd  <  r  ',,f  ji‘  ; 


•nd  er action^; 

figure  t-H  Pd'Hjl  ja.  'a-  bv,*S\  'Oi  c' i  •  ">n 


u K*a  iro.Y>  D*ta  ■•’i  uv.i  Vh  FiiU'  b <  fn,  ,  Jr\iAtl  *3  F^UK*  .aJ 


package  KEY-MANAGER* is 
type  KEY  is  private;  /  ? 
procedure  GET_KEY(K ; out  KEY); 
function  V  (X,Y  :  KEY)  return  BOOLEAN; 
private 

type  KEY  is  new  INTEGER  range  0  . .  INTEGER'LAST , 
end  KEYJMANAGER;  •ia" 

package  body  KEY  _M  AN  ACER  is 
NEXTJCEY  :  KEY  :=  1  >  r-  own  variable  -  exists  between 

—  procedure  calls 
procedure  GET_KEY(K  KEY)  is 
begin 

K:=  NEXTJCEY;  T_; 

NEXT-KEY  :=  NEXTJCEY  +  1, 
end  GETJCEY; 

function  V(X,Y  :  KEY)  *|l<im  BOOLEAN  is 
begin 

return  INTEGERS  )<ISSB}ER(Y); 
end  V; 

end  KEY-MANAGER;  LAN. 


(Taken  from  Programming  with  Ada  by  Peter  Wegner! 


pack«g«  8_R  ia 

type  NUMBERS  ia  raaga  0  ..  99; 

procedure  TAKE  (A_NUMB£R  :  one  NUMBERS); 
procadara  SERVE  (NUMBER  :  ia  NUMBERS); 
faaccioa  NOWISE RV INC  return  NUMBERS; 

end  B—R; 

package  body  S_R  ia 

SERV^A^MATIC  :  NUMBERS  :•  i; 

procedure  TAKE  (A_NUNBER  :  aoC  NUMBERS)  ia 
bagia 

A  NUMBER  :•  SERV_A_MATIC; 

SERV_4_MATIC  SERV_A_MATIC  ♦  l; 
aad  TAKE? 

procadara  SERVE  (NUMBER  :  ia  NUMBERS)  ia  separate; 
function  BOW_SERVINC  racara  NUMBERS  ia  aeparate; 
aad  B  R; 


ai Ch  B_R; 
uae  8_R; 

procadara  ICE-CREAM  ia 

YOU RENUMBER  :  NUMBERS; 

bagia 

TAKE  ( YOUR_NUMBRR) ; 
loop 

if  NOV_SERVIHC  -  YOUt_NUMBER  ebon 
SERVE  (YOURJIUMBER) ; 
exit ; 
aad  if; 

aad  loop; 

aad  ICE_CREAM; 


aieh  B__R ; 

aaa 

procadara  ICE_CREAH  ia 

YOUR_NUMBEE  :  NUMBERS; 
bagia 

TAKE  ( YOUR_NUMBER) ; 
loop 

if  NOW  SERVING  “  YOUR_NUHBER  Chan 
SERVE  ( YOU RENUMBER) ; 
axie; 

alaa 

YOUR  NUMBER  ;•  YOUR^NUNBER  -  l; 

aad  if; 

aad  loop; 
aad  ICE  CREAM; 


^Tak&l  k'crslt/'  /)?& ,  ^  Court c  Stwitaf 


pockaga  B_R  ia 


type  NUMBERS  il  privata; 


procadara 

procadara 

faactioa 


till  (A  HUMBER  :  o«t  HUMBEES); 
SERVE  (HOMIER  :  i»  HUMBEES); 
HOW  SERVIHS  r«c«t«  HUMBEES; 


f rivat* 

t7r.  HUMBEES  is  rsm*s  0  .. 
<sB  B  E; 


si c  b  8_R; 

eaa  ; 

procadara  1CE_CUAM  ia 

YOUR_NUHBER  :  BUHlERS ; 

b«|i« 

TAKE  (YOUR_NUMBER> ; 
loop 

if  BOW  SERVING  •  YOUR_NUMBER  Chao 
SIEVE  (YOUE^BUKIEE) ; 

•sic; 

alao 

YOUE__NUHBER  :•  NOW^SERVIMC; 

aad  if; 

ood  loop; 
aad  ICE  CREAM; 


packaga  B_i  ia 

typa  HUMBEES  ia  liaitad  privata; 


procadara  TAKE  (AJWHBEE  :  oaC  HUMBEES )  ; 
procadara  SERVE  (NUMBER  :  ia  NUMBERS); 
fames ioa  NOW_SIRVINC  retire  HUMBEES; 
faactioa  "•""(LEFT,  RICNT  :  ia  HUMBEES) 
retire  BOOLEAN; 


faactioa 

private 


CL0SE_II0UC1  ( A_N UMBER  :  io  NUMBERS) 

retire  BOOLEAN; 


type  HUMBEES  ia  raega  0  ..  99; 
aad  B_R; 


vith  B_R; 

•aa  B— E; 

procadara  ICE-CREAM  is 

YOUR_NOMBER  :  HUMBEES ; 
procadara  GO  TO  DQ  ia 


Regia 

TAKE  (YOUR  NUMBER); 
if  NOW^S  IRVING  “  YOUR_NOHBER  tkaa 
SERVE  ( YOURJIUHBfl) ; 
alaif  CLOSI_EHOUC«  ( YOURJIUHBER)  them 

akila  NOW_SIRVtNG  /•  YOUR_NUHBER  loop 

"""  --  unit  your  turn 

aad  loop; 

SERVE  ( YOU t  NUMBER); 


alao 

CO_TO_DQ; 

aad  if? 


aad  ICE  CREAM; 


Implications  of  Using  the 
Specification's  Private  Section 

□  Forces  recompilation  of  specification 
and  any  client  modules  if  the  data 
structure  used  to  implement  a  type 
changes. 

□  Can  be  avoided  if  data  structure  needed 
for  a  package  can  be  internal  to  the 
body  of  the  package  but  this  disables 
client  s  ability  to  declare  multiple 
objects  of  a  particular  type.  Haberman 
and  Perry  refer  to  "open  type"  and 
"unique  object"  solutions. 

□  Can  be  avoided  by  making  private  type  an 
"access"  (pointer)  type 
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;.pa  mction.ftoo*  11  arravvl..2>  ot  inctoar: 


tacxaga  lnt_IG  it  nae  rext_IG. Integar_IG (integer ; . 

r- 

function  rtakeFr action iN.  0  i  intigtn  return  Fraction  aa 
F  t  Fraction! 
oegin 

it  0  /*  0  than 

F  I »  nee  Fraction_Noaa: 

—  to r  traction*  v  0.  tha  nuaarator  earn  as  tha  nagat 
i  4  D  C  0  tnar. 

F  <  1 )  j«  -Ni 
F  <2/  i-  -L s 

aisa 

F  ( 1  >  i  »  Hz 
F(2:  I-  fj 
ana  iti 
return  r- i 

•  i  se 

raise  £eroi)enominator£rrori 
ana  iti 

ana  MaxeFractioni 


function  rlumeriX  i  fraction)  return  intaqar  aa 

oagir. 

return  X ( 1 ) i 
-  and  humor) 

function  DenoeiX  i  Fraction;  return  integer  is 

oegin 

return  X(2>i 
end  Genoa i 

procaaura  PutiX  i  in  Fraction;  is 
oeoin 

int  _lO.Fut (Nuaer  \X) , 1) | 

Text_IQ. Put  < "/■ ; | 

Int  _I0. Put  CPonoo i  X  >  •  l  >  f 
Text_I0.Put ("hi  there"; i 
ana  Put» 

» 

function  <9C0(X.  V  i  integer;  return  integer  is 

begin 

l *  V  •  0  then 
return  X i 

eise 

return  dCOiY.A  eoo  Y>i 
end  it i 
ana  SCDi 


oroceourw  dw 

b«A. 

1  <  in 

out 

inteaer ; t 

orocedur*  &m 

*  ■  in 

out 

integer;  is 

Tmmo  »  integer  » 
oegin 


L  ve  si  gn 


£  a  -  \j -j e  F  ric  t  .  OT.i  IS 


is 


Fraction) 


ntan  iataftr  la 


puoooMira  Fat(X  t  in  fraction)  is 

Nfla 

Xnt  io. Put (Pmoir (»),!); 
tnsE  xo.pnt (•/•)/ 

ZBC  fB .  IM  (Donon(X)  ,  X)  I 
•Ml  Pu£f 


(X.  x  I 

1M*<  tfeon 


ntn  Xi 


procedure  ftnp(X,  1  *  la  mt  iMprl  i 
•weMyw  SeaatX.  1  i  la  Mt  iatMtr)  ia 


tMp  i-  X> 
X  I-  Tf 
T  i-  Tonp* 


■.  •  * 


(X  « 

I 


•  *•  M 

•  II 

if  P  *  • 

IM»d.O)l 

Ml  Iff 


rtturn  metion  la 


(X))f 

<X))f 


ica(KMV(X)/eCD(l,D),  Danes (X) /GCD(M,  0) )  ; 


function  Reciprocal (X  :  fraction) 

fe**rin 


return  fraction  io 


► 


function  (X,  Y  s  Fraction)  rttan  Fraction  is 

bag  In 

ratun  Induce (  ■ajaaPraetiaafl— r(X)  »QMai(T)*baar(T)«o«maffl , 

and 

function  •'*(*,  T  t  Praction)  ratun  fraction  la 

begin 

ratun  baduca(  lakaPraction(l«Mer(X) *Oenon(Y) -Hfuner(Y) •Denae(Z) , 
Donee  (X) *Deoon(Y) )  )> 

and 

function  •••  (Xf  X  t  Praction)  ratun  fraction  ia 

begin 

ratun  *educa(  ■akaPraction(Waar(X)  munar(Y)  .Danoa(X)  •Oonoa(T) )  ); 
and  •*■> 

function  ■/"  (X,  t  j  fraction)  ratun  Praction  ia 

begin 

ratun  Induce  (  (X*beciprocal(Y) )  )  > 
and  •/"> 

function  Equal  (X,  Y  :  fraction)  ratun  boolean  ia 

boqin 

ratun  luaar(X)  •Denoa(Y)  -  lunar (T) *Oanoa(X)  ; 
and  Equal; 

function  (X,  T  :  Praction)  ratun  boolean  ia 

begin 

ratun  lunar  (X)  •Oonan(Y)  <  lunar  (Y)*Oanon(X) » 
and  ■<•; 

function  ■>-•  (X,  Y  :  Praction)  return  boolean  la 

begin 

return  lunar(X)  •oanon(Y)  >■  lUnar(Y)  *  Panne  (X) ; 
and  •»•*; 


fleet  la 


package  MANAGER  is 
type  PASSWORD  is  private; 

NULL-PASSWORD :  constant  PASSWORD; 
function  GET  return  PASSWORD; 
function  IS_VALID(P  :  in  PASSWORD)  return  BOOLEAN, 
private 
type  NODE; 

type  PASSWORD  is  access  NODE, 
end  MANAGER; 

package  body  MANAGER  is 
type  NODE  is  range  0  . .  7000; 


end  MANAGER; 


^  Uko \  jvo,r\  5of 
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□  Reason  private  types  must  be  included 
in  private  part  of  the  specification 
rather  than  put  in  the  body  of  a  package 
is  that  compiler  needs  to  be  able  to 
determine  how  much  storage  to  allocate 
for  instances  of  private  types  declared 
by  client  modules. 

□  "Inclusion  of  private  data  types  in  the 
package  specification  implies  that  a 
change  in  representation  of  the  private 
data  type  will  require  recompilation  of 
the  program  unit  which  contains  the 
package  specification,  thus  violating  the 
principle  that  package  specifications  are 
recompiled  only  when  there  are 
specification  changes  which  affect  the 
user.  This  appears  to  be  ivery  heavy 
price  to  pay  for  the  simplification  in 
compiling  and  loading  that  is  achieved 
by  including  private  declarations  in  the 

Specification  part.  [Taken  from  Programming 
with  Ada  by  Peter  Wegner] 


Using  a  Package 

□  via  textual  inclusion  in  the 
client  module 

D  package  has  NOT  been  separately 
compiled 

0  package  is  visible  in  client 
from  the  point  It  is  first  declared 

0  spec  and  body  do  not  have  to  be 
textually  contiguous  in  client  but 
spec  must  come  first 


□  via  context  specification  using 
the  "with"  clause 

D  package  has  been  separately  compiled 
and  is  made  visible  via  the  with  clause 

0  this  method  supports  ideas  of  modularity 
and  localization  better  than  textual 
inclusion  method 

□  must  prefix  references  to  items  with 
the  package’s  name  and  a  period 

D  necessitates  prefix  form  of  notation 
for  use  of  an  overloaded  operator 
such  as  *+*  or  ,  etc. 

D  can  use  ‘renames'  clause  to  allow 
use  of  operators  in  infix  form 

0  can  use  'USE'  clause  to  gain  direct 
visibility  to  items  in  the  package 

0  use  of  "USE'  clase  can  create 
ambiguity  and  pollute  the  name  space 

□  Both  methods  import  ALL 
elements-of  the  visible  part 
of  a  package  --  no  selective 
importation  such  as  in 
Modula  2  --  argues  for 
carefully  segmenting  packages 
to  achieve  same  effect 


procedure  COMPLEX-COMPUTATIONS  is 
procedure  ONE, 
procedure  TWO; 
package  COMPLEX  is  . . . 
procedure  ONE  is  . , . 
procedure  TWO  is . . . 
package  body  COMPLEX  is . . . 

X,  Y,  Z  :  COMPLEX.COMPLEX-NUMBER , 
begin 

Z  :*  COMPLEX.'+'(X,Y); 
end; 


with  COMPLEX, 

procedure  COMPLEX-COMPUTATIONS  is 
procedure  ONE, 
procedure  TWO; 
procedure  ONE  is . . 
procedure  TWO  is  . . . 

X,  Y,  Z  :  COMPLEX  .COMP  LEX_NUMBER, 
begin 

Z  :=  COMPLEX."+"(X,Y); 
end; 


with  COMPLEX,  use  COMPLEX; 
procedure  COMPLEX-COMPUTATIONS  is 
procedure  ONE, 
procedure  TWO; 
procedure  ONE  is 
procedure  TWO  is 

X.  Y,Z  :  COMPLEX_NUMBER , 
begin 
Z  ;=  X  +  Y, 
end. 


laasaplls  sir  a  IPMKME 

package  GOLF-INFO  Is 

type  GCLF_CLUB  Is  (DRIVER,  IRON,  PUTTER,  WEDGE,  KASHIE); 

type  GOLF_SCCRE  is  range  I  . .  2CC; 

type  HOLE— NUTdEER  Is  range  118; 

type  HANDICAP  Is  range  0  . .  36, 

type  SCCRELJDA.TA  is  array  <HCL£_NirSER)  of  GOLF-SCORE, 

PAR_FCR_COURSE  :  constant  GCLf_SCORE  :*  72; 

PAR-VALUES  :  constant  SCORE-DATA  :« 

(1  »>  5,  2  =>  3,  3  »>  a,  4  =>  4,  5  =>  3,  6  »>  a, 

7  =>  5,  8  =>  a  g  »>  4,  !C=>  3,  1  1=>  a,  I2=>  a, 
I3=>  4,  !A=>5,  !3=>  3,  I6=>  a  |7=>  a  |8=>S) 

procedure  COMPUTE_TOTal_SCORE(SCCRE5:  In  SCORE-DATA, 

TOTAL:  out  GOLF-SCORE:; 

end  GCLF_!NFO; 
package  Doay  GOLFJNFO  Is 

procedure  CCI7PUTE_TCTAl_SCORE(SCCRES.  In  SCORE-DATA, 

TOTAL,  out  GOLF_SCORE)  Is 

begin 

TOTAL  :=  0, 

for  HOLE  In  HOLE— NLT3ER  loop 
TOTAL  :=  TOTAL  ♦  SCCRES(HOLE); 
end  loop, 
end; 

end  GOLF_INFO; 

[Taken  from  Ada:  An  Introduction  Dy  Henry  Ledgard! 


Mb®  &&K9  PA6KME 

with  GOLF_INFO,  TEXT  JO; 
use  GOLFJNFO.  TEXTJO; 
procedure  K£EP_SCORE  is 

MY-SCORES  :  SCORE-DATA; 

TOTAL-SCORE  :  GOLF_SCORE; 

begin 

PUT(Tet‘s  have  the  scores  for  each  hole.’); 
for  HOLE  In  HOLE-NUMBER  loop 
NEW-LINE; 

PUT(HOLE);  PUTC  *); 

GET(MY_ SCORES(HCLE)); 
end  loop; 

COMPUTE— TOT A1 _ 5C0RE(MY._SC0RE5,  TOTAL-SCORE); 

NEW-LINE; 

PUT(“Your  total  Is  *);  PUT(TOTAl_SCOREj); 

NEW_LINE, 

If  TOTAL-SCORE  <  PAR-FOR-COURSE  then 
PUT ( P AR-FCR-COURSE  -  TOTAL-SCORE);  PUTC  Under  Par"); 
els  If  TOTAL-SCORE  =  PAR_fQR_CQURSE  then 
PUTCAn  Even  Par"); 
else 

PUT(TCTAL_SCCRE  -  PAR-FCR-CQURSE);  PUTC  Over  Par"); 
end  If, 


end  KEEP-SCORE; 

[Taken  from  Ada:  An  Introduction  by  Henry  ledgardl 


procedure  OUTER  is 
package  HEIGHT  is 
ID  :  INTEGER; 
VALUE  ;  FLOAT, 
end  HEIGHT, 

package  WEIGHT  is 
ID  :  INTEGER, 
VALUE:  FLOAT, 
end  WEIGHT, 


procedure  INNER  is 
use  HEIGHT,  WEIGHT, 
begin 

HEICHT.VALUE  :=  65-3, 

WEIGHT.VALUE  :=  HEIGHT. VALUE, 

VALUE  :=  63.5,  ~  unqualified  name  causes  ambiguity 

end  INNER, 


begin 

VALUE  :=  63.5, 
end; 


—  illegal  because  outside  scope  of  USE 

—  statement  so  name  must  be  qualified 


[Example  taken  from  Programming  vith  Ada  by  Peter  Wegnerl 


PROGRAM  3.8  Modula-2  Venioa  of  Program  3.7 


!>  This  definition  module  is  a  separate  compiland  and  is 
compiled  before  the  program  ReverseName  is  compiled.  •) 

€FINfTION  MODULE  Stacks; 

^  •  $SEG:*8;  •) 

(•  This  is  a  compiler  directive  required  by  the  particular  operating  system  being 
used.  It  assigns  a  segment  number  of  a  definition  module.  In  general,  this  is 
not  required.  •) 


EXPORT  QUALIFIED 
(•  type  •)  Stack. 

(•  proc  •)  Empty, 

(•  proc  •)  Pop, 

(•  proc  •)  Push. 

(•  proc  •)  Initialize. 
(•  proc  •)  Remove; 


TYPE  Stack;  (•  Representational  details  hidden  •) 


PROCEDURE  Empty(S:  Stack)  :  BOOLEAN; 
(•  Returns  true  if  stack  is  empty.  •) 


PROCEDURE  P op(VAR  S  Stack)  CHAR; 
(-  Strips  top  element  off  stack  •) 


PROCEDURE  Push(VAR  S  Stack;  X:  CHAR); 
(•  Adds  element  to  top  of  stack.  •) 

PROCEDURE  lnitialize(VAR  S.  Stack); 

(•  Sets  stack  to  empty.  •) 

PROCEDURE  Remove(VAR  S  Stack); 

(•  Removes  stack  from  memory.  •) 

END  Stacks 
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MODULE  ReverseName.  (•  This  is  the  program.  •) 

(•  In  Modula-2,  all  reserved  words  must  be  given  in  uppercase  •) 

FROM  Stacks  IMPORT  Empty,  Pop.  Initialize,  Remove,  Stack. 

FROM  InOut  IMPORT  WriteString.  WriteLn.  Write.  Read,  EOL; 

PROCEDURE  Find  Middle  (VAR  S  :  Stack)  CHAR; 

(•  We  use  an  algorithm  different  from  that  in  Program  3.7  •) 

VAR  LocalStack:  Stack, 

Ch  :  CHAR; 

BEGIN 

Imtialize(LocalStack); 

REPEAT 

ch;  =  Pop(S); 

Push(LocalStack.ch); 

UNTIL  Ch=  V; 
ch:=*Pop(S); 

Push(LocalStack.ch) ; 

(•  Now  we  restore  the  stack  S  to  its  original  form.  •) 
WHILE  NOT  Empty(LocalStack)  DO 
Push(S,Pop(LocalStack)); 

END; 

RETURN  ch 
END  FindMiddle; 

VAR  Name  :  ARRAY[1.  .40]  OF  CHAR; 

A  :  Stack: 


"by  R.uWner  arvcl  ^  S  i  rv  ccuc  0 


Limitations  on 

Structure  Specifications  in  Ada 


□  No  support  for  declaration  of  structure 
graph  interconnections  at  specification 
level 

□  Can  include  this  information  with 
comments  as  an  alternative 


package  C  is 
required^); 
is  required  by  (A, B); 
procedure  Cl  (  ); 

procedure  C2(  ), 

end  package  C; 


[Taken  from  System  Design  vrtth  Ada  by  R.J.A.  Buhr] 


Package  Applications 


□  Encapsulate  related  data  types, 
constants  or  objects. 

O  only  objects  and  types  exported,  no  pgm  units 
0  package  body  may  or  may  not  be  present 
0  facilitates  consistency  by  factoring  out 
common  elements  used  by  may  modules 

□  Encapsulate  related  program  units. 

□  only  program  units  exported,  no  objects 
and  types 

□  Embody  an  Abstract  Data  Type  (ADT) 

□  objects,  types,  and  program  units  exported 

□  state  information  not  maintained  in  body  of 
the  pkg 

□  supports  abstraction  and  information  hiding 

□  Embody  an  Abstract-state  machine. 

□  objects,  types,  and  program  units  exported 
0  state  information  maintained  in  body  of  pkg 

□  Encapsulate  tasks  * 

0  often  used  purely  to  enclose  task(s)  because 
they  cannot  be  separately  compiled 
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oac:<aqe  TRIG_PKS  is 

function  FACTOR  IAL  (  n :  in  integer)  net  urn  f -cet  : 

—  returns  n1  as  a  floating  point  value 

function  SIMPLIFY <angle_in_degrees  :  in  integer)  ret  urn  integer: 

—  returns  an  equivalent  angle  (in  degrees)  for  ANGLE_ I N_CEGREES 

—  which  is  positive  and  between  0  and  360 

function  RADIANS (degrees  :  in  integer)  return  float: 

—  returns  radian  value  for  DEGREES 

function  S IN (ang le_in_degrees  :  in  integer)  return  float: 

—  returns  the  sine  of  PNGLE_IN_DEGREES 

function  CDS  (ang  le_m_degrees  :  in  intece-)  return  f..>:  ; 

—  returns  tne  ccsme  of  ANGL£_  IN_DE3F£E3 

end  TRIG  PKG: 


package  body  TRIS_PKG  is 

FACT  :  array (0. .IE/  of  float  := 

<1.0. 

1.0, 

2.  0. 

6.  0, 

24.  0, 

120. 0. 

720. 0, 

5040. 0, 

40320. 0, 

362980. 0, 

3628800. 0, 

3391 6800. 0, 

479001600. 0, 

6227020800. 0, 

87178291200. 0, 

1307674368000.  O'  : 

function  FACTORIAL <n:  in  integer)  ret  urn  float  is 
x  :  float  :=  1.0; 
beg  i  n 

if  n  <  O  then 

—  if  n  is  NEGATIVE  return  ZERO  to  indicate 
ret  urn  0.0; 

elsif  <<n  >=  O)  and  <n  <  =  15 )  )  then 
return  FACT(n); 
elsif  n  >  15  then 

for  i  in  l..n  loop 

x  : =  x  *  float ( i :  ; 
end  loop: 
ret  urn  x  ; 
end  if; 
end ; 


function  S IMPL IFV  (ang  le_  m^d*qr»*5  :  in  mc«gir)  net  urn  integer  is 

Angle  :  integer; 
beg  i  n 

Angle  :»  ang le_ in_deqrees  rtm  260; 
if  Angle  <  0  then 

Angle  : »  260  ♦  Angle; 
end  i f ; 
ret  urn  Angle: 
end  ; 

function  RAD  IONS  ( cegrees  :  m  integer  return  #loat  is 
pi  :  floAt  :*  2.  1<*1*32SS: 

beg  i  n 

ret  urn  ((oi/float(l80>>  •  floAt  (deqree*  ;  • 
end ; 

f  unc  tion  SINfano  !e_i  n  _ degrees  2  in  ntt#a*r'  ret  jr*i  *1  ;*i 
sum  :  floAt  :*  0.0: 

Anqle  2  inteqer; 
temo_angIe  :  inteqer; 
beg  i  n 

t  rno  _anq  1  e  :  »  S  I  .''•PL  I  -  v  '  anc  1  e  _  i  n_ceqre es  : 
l*  temo_anqie  >*  180  then 

—  P  ;r*3:  Ana  second  quad-ant  used  for  come 

—  because  como-itat  .on  is  me--?  accurate 

Angle  temo_angle  -  \ eO : 

e  1  se 

Anqle  : 3  temo_anaie: 
end  i f ; 

for  i  in  0. . 7  looo 

Sum  : sum  ♦  v  <  f ’.OAt  '  i  (-1  )  •■•i  M  *  ( POO  f A*S  '  Ang  1  e 

/  (  FACT  2 •  i  ♦  1  )  )  >  ; 

end  looo: 

—  Account  for  use  of  only  first  Arc  second  quadrant  angles 

—  in  computation 

if  tf«o _anq I e  >  l 80  then 
return  ( -Sum  >  ; 

else 

return  sum; 
end  i f ; 
end  ; 

funct.on  CDS < anq le _ i n_deqrees  :  in  integer)  return  float  is 
sum  float  : m  0. 
angle  mteqer: 
temp  anqle  inteqer; 
beg  i  n 

temp_angle  :»  S I HPL IF <  ( ang Ie_ i n ^degrees ) ; 
if  t  emo  _ anq 1 e  > ■  180  then 

—  First  and  second  quadrant  angles  used  for  comoutjc .on 

—  because  comautation  is  mor»»  accurate 
angle  : =  temo  angle  -t80: 

else 

anqle  :»  temo_anqle; 
end  i f ; 

for  i  in  0.  .  7  looo 

sum  :  *  sum  (  (  f  1  oat  (<<-!>  ♦♦  i  >  >  ♦  (RADI  ANS  <  anq  le1  ■  '  > 

/  <  FACT (2*i  )  >  )  ; 

end  looo: 

—  Account  for  use  of  only  first  aro  second  duadrint  angles 

—  in  comoutat ion 

if  temo  anqle  >  *  180  then 
ret  urn  ( -sum  >  : 

else 

return  sum: 
end  i "  ; 


end  TRIG_OMG: 


with  TRIG_PKG,  GIGI_GR0PHIGS_PK3.  TYPES: 
use  TRIG_°KG.  GIG:  _GRPD*-'ICS_PKG.  T^^ES: 

package  TURTLES  is 

subtype  ANGLE  is  integer  range  0. -360: 
type  TURTLE  is  private; 


—  TURTLE  CONTROLS  — 


—  PEN  CONTROLS 

procedure  UP(myturtle  :  in  out  TURTLE): 
procedure  DOWN (myt urt le  :  in  out  TURTLE): 

function  PEN_IS_D0WN (myt urt le  :  in  turtle)  return  boolean: 
procedure  NEW_PEN (myt urt le  :  in  out  TURTLE:  colour  :  in  COLCRTYPE) 

—  MOVEMENT  CONTROLS 

procedure  NORTH (myt ur: le  :  m  out  TURTLE): 
procedure  SOUTH (myt urt le  :  in  out  TURTLE) ; 
procedure  EAST (myt urt le  :  in  out  TURTLE) : 
procedure  WEST (myt urt le  :  in  out  TURTLE) : 

procedure  MOVE (myt urt le  :  in  out  TURTLE;  n  :  m  integer) ; 
procedure  TURN (myt urt le  :  in  out  TURTLE;  a  :  in  ANGLE) : 
procedure  TURN_T0 (mvt urt le  :  in  out  TURTLE:  a  :  in  ANGLE/ ; 


ori vate 

type  POSITION  is  (pen_up,  oen_dOwn)  : 

type  PEN  is  record 

□en_oosition  ;  POSITION; 
pen_colour  ;  C0L0RTYPE; 
end  record ; 

subtype  XCQORD  is  integer  range  0. .768; 
subtype  YC00RD  is  integer  range  0. .479; 

tyoe  POINT  is  record 

x  :  XCOORD; 
y  ;  YCOORD ; 
end  record ; 

tyoe  TURTLE  is  record 

pen_st at  us  :  PEN  : =  (pen_down,white) ; 
heading  :  ANGLE  :=  0; 
location  :  POINT  :*  (350,250); 
end  record ;  ' 


TURTLES 


package  body  TURTLES  is 


—  TURTLE  PEN  CONTROLS  — 

procedure  SET_PEN_COLOUR  (myt urt  le  :  in  out  TURTLE;  colour  :  in  COLCRTYPE)  ; 
procedure  S£T_PEN_COLOUR (myt urt le  :  in  out  TURTLE;  colour  s  in  COLQRTYPE)  is 
begin 

myt  urt 1 e.  p«n_st  at  us . pen_co 1 our  : =  colour; 
end ; 


procedure  NEW_PEN (myt urt le  :  in  out  TURTLE;  colour  :  m  COLORTYOSj  is 

begin 

SET_PEN_COLOUR (myt  urt 1 e, co lour)  ; 
end ; 


function  PEN_IS_DOWN (myt urt le  :  in  TURTLE)  return  boolean  is 
begin 

if  myturt  le- oen_status.  oen_oosiT  ion  =  pen_down  t.Ten 
return  true: 

else 

return  false: 
end  i  f : 
end ; 


edure  UP(myturtle  :  in  out  TURTLE)  is 
htjin 

myt  urt  le.  pen__st  at  us.  pen_pos  1 1  ion  :=  pen_up; 
end  ; 


procedure  DOWN (myt urt le  :  in  out  TURTLE)  is 
begin 

nvt ur 1 1 e.  oen_st at  us. pen_pos 1 1 ion  :=  pen_donn; 


DRAWING  and  UN-DRAWING  the  TURTLE 


rocedure  TRANSFORM (myturt le  :  in  TURTLE;  x  :  in  integer;  y  :  in  integer; 

ne»»_x  :  out  XCOORD;  new_y  :  out  YCOORD; 
theta  :  in  ANGLE) ; 

rocedure  TRANSFORM (myt urt le  :  in  TURTLE;  x  :  in  integer;  y  :  in  integer; 

nev»_x  :  out  XCOORD;  new_y  :  out  YCOORD; 
theta  :  in  ANGLE)  is 

eg  i  n 

new_x  s=  myt  urt  le.  locat  ion.  x  +- 

integer ( float ( x ) *C3S (thet a)  -  f loat (y ) *SIN (thet a) - ; 
new_y  myturtla.  location,  y 

i  nteger  (  float  ( x  )  *SIN  ( thet  a )  ■+■  f  I  rad  y )  *CCS  (Theta.  '  : 

nd ; 


rocedure  DRAW_TURTLE (myt urt 1 e  :  in  TURTLE1 : 
rocedure  DRAW_TURTL£ (myt urt le  :  in  TURTLE)  is 
x, y  :  integer; 
eg  in 

SETWR IT INGMGDE '.real ace)  ; 

SETWRITINGCOLCR (myturt le. ce- _= t  a~  us . oen_co lour  : 
SETCL'RSORAT  (myt  urt  le.  locat  ; on.  x.  myt  urt  la.  1  oc3t  i  on.  y  ;  : 
TRANSFORM  (myt  urt  le.  0,  —18,  x,  y,  myt  urt  la.  head  me  : 
DRAWLINETO ( x, v'  ; 

TRANSFORM (myturt le, 24, 0. x, v. 

myturt le. heading) ; 

AWLINETQ (x, y )  ; 

RANSFQRM (myturt le, 0. 18, x, y, 
myturt le. heading) ; 

DRAWLINETO (x, y) ; 

TRANSFORM (myt  urt le, 0, 0, x,  y , 
myturt le. heading) ; 

DRAWLINETO (x,  y)  ; 

cTTCL'RS0RAT  (myturt  le.  locat  ion.  x,  myturt  le.  locat  ion.  y)  ; 


'  ..dure  UNDRAW_TURTLE (myt urt le  :  in  TURTLE1; 
rn;.jrt  UNDRAW_TURTLE  (myturt  le  :  in  TURTLE)  is 
/. ,  ■  integer; 

luTi4JI  TINGMODE  (erase)  ; 

33TWRITINGCQL0R (dark) : 

SETCURSORAT (myt  urt le. locat ion. x, myt  urt le. locat ion.  y )  ; 
TRANSFORM (myturt le, 0, -18, x, y, myturt le. heading) ; 

DRAW!  TNETQ(x,  y)  ; 

TRAt  jRM  (myturt  le,  24,  0,  x,  y, 
myt urt le. head ing )  ; 

ORA.  uINETOCx,  y)  ; 

TRANSFORM (myt urt le, 0, 18, x, y, 
myturt le. heading) ; 

DRAWLINETO ( x, y> ; 

^ANSFORM (myturt le, 0, 0, x, y, 
myt  urt  1  e.  head  i  ng )  ; 

DRAWLINETO (x, y) ; 

SETCURSORAT (myt  urt 1 e.  locat ion. x , myt  urt le.  1 ocat ion. y )  ; 

' 

) 

j  n 


TURTLE  WOVETENT  CONTROLS 


in  out  TURTLE; 


in  inttg«r)  is 


proctdurt  WOVE (myturt! 
bag  i  n 

UNDR  A  W_  TURTLE  (myturt  la>  ; 

if  REN_ IS. DOWN  (my t ur-t  la)  th*n 

SETWRITINGWQDE (rtplac*) ; 

SE iURITlNGCOLOR (myturt la. Dan_statu*.  ptn_colour)  ; 

DRPWUINETQ  Float  (n)  ♦CCS  (myturt  la.  haading) 

float (myturt It.  locition.  x)  >, 
intagar(  float (n)  ♦S  rN  (myt  urt  la.  haad  mg ) - 
f loat (myturt la.  location,  y)  )  >: 

a  Isa 

MQVECURSORABS  (  intagtr  (  f  loat  (n)  ♦COS  (myturt  la.  haadmg)  - 
float (myturt la. location. x)  ), 
intagar (  f loat  <n> ♦SIN (myturt la. haadxng) - 
float (myturt la. locat ion.  y>  >  ); 

and  if; 

QUERYC’JRSCRPQS  <myt  art  la.  locat  ion.  *,  myt  urt  la.  locat  ion.  v )  • 

DRAU_ TURTLE (myturt la> ; 


procedure  TURN  ( my  t  urt  1  a  :  in  out  TURTLE:  a  :  m  ANGLE) 
bag  i  n 

UNDRftU^TuRTLE (myturt la) ; 

myturt  la.  haad  me  :»  SIMPL IFV  (myt  urt  la.  ‘-laad  *  no  •*-  a). 
DRfiW^TURTLE (myturt la) ;  “ 


procsdur?  TURN^TO  (mvt  urt  1  a  :  i  n  out  TURTLE:  a  :  in  ANGLE  •  is 

bag  in 

UNOR«U_TURTLE (myt urt la) ; 

myt urt la. baad i ng  ;*  a; 

D R«W_ TURTLE  (myturt  la)  ; 


proc*dun  NORTH (myt urt la  s  m  out  TURTLE)  is 
bag  i  n 

TURN^TO (my t urt la, 30)  ; 

MOVE (myt urt la,  1)  ; 


procadura  SOUTH ( my t urt 1 a  ;  in  out  TURTLE)  is 
bag  i  n 

TURN^TO (myt urt la,  270)  ; 

WOVE (myturt la.  1 >  ; 


procadura  EAST (myturt la  :  m  out  TURTLE )  is 
bag  i  n 

TURN__TO  ( my t  urt  1*.  3)  ; 

WOVE (myturt la.  1  )  ; 


procadura  '♦EST  (myt urt  la  :  m  out  TURTLE'  is 

bag  in 

TURN^TQ (my t urt la.  1QO)  ; 

WOVE ( myt  urt la.  1 >  ; 


bag  i  n 

setscreenscale  < o.  i to,  470.  o> ; 

CLEARSCRESN ; 

SETCURSORAT (0,0) ; 
and  TURTLES; 


package  Termi  na1_0r  i  ver_Package  is 

task  Termina1_Dr i vsr  is 

entry  Read_Character ( C  :  out  Character); 
entry  Write_Character(C  :  in  Character); 
entry  Reset: 
entry  ShutQown; 
end  Terminal_Dr1ver; 

end  Terminal_Driver_Packag8: 

with  Queue_Package ,  low_Leve 1_IQ ,  System; 
use  Low_i.eve1_I0; 

package  body  Termina1_Driver_Package  is 
task  body  Terminal_Driver  is 

--  Group  all  of  the  machine  dependent  cc.*sti'*s  together 

Conso1e_Input_Vector  ;  constant  System. Adc*iiS  '■*  8#60#; 
Console_Output_Vector  ;  constant  System. 4a:*fs s  :*  8#64#; 
Enab 1 e_Interrupts  :  Integer  ;«  8#10Q#: 

Write_Time_Out  :  constant  Duration  :*  0.5: 

Number_Of__Li  nes :  constant  :■  Z; 

LineLength:  constant  :*  132; 

task  type  Devi C8_Reader  is 
entry  Interrupt: 
entry  StartUpDone: 

for  Interrupt  use  at  Console_Input_Vecto*: 
end  Device_Reader ; 

task  type  Devi  ce_Wr  i ter  is 
entry  Interrupt; 
entry  StartUpDone; 

for  Interrupt  use  at  Console_Output_Vecto*: 
end  Device_Wr iter ; 

package  Char_Queue_Package  is  new  Queue_5ac^2ge(Character' : 
use  Char_Queue_Package ; 

type  OriverStateBlock  is 

record 

InputCharSuf f er ,  OutputCharBuf f er  : 

B1  ock ing_Queue(Number_Of_Li ne  s*Li re.angth ) ; 

CurReader  :  Dev i ce_Reader ; 

CurWriter  :  Device_Writer; 

end  record ; 

type  RefToBlock  is  access  DriverStateBIock; 

CurState;  RefToBlock; 

task  body  Devi ce_Reader  is 
Templnput  ;  Character; 
begin 

accept  StartUpDone; 

Send_Contro1(Consol e_Xeyboar d_Contr ol .  Enab1e_Interructs) 

loop 

accept  Interrupt  do 

Receive_Control (Console_Keyboard_Data.  Templnput) ; 
end  Interrupt; 

Aopenc(Cur3tata.InDUtChar3uffer.  Temp  Input) : 
end  loop ; 

end  5 e a j e r  :  _  - 


TempCutput  :  Character; 

begin 

accept  StartUpDone; 

Send_Con trol (Consol e_Pr in tar_Contro 1 ,  Enable_ Interrupts); 
accept  Interrupt;  --  spur'ous  interrupt  caused  by  Send_Control 

loop 

Remove ( Cur S tata . OutputChar Buff er ,  TempOutput)  ; 

Sand_Contro1 (Consol e_Pr in ter_Dat a ,  TempOutput) ; 

select 

accept  Interrupt; 
or 

delay  Wr i te_Time_Out ; 
end  select : 
end  loop ; 

end  Devica_Writer ; 

procedure  ShutDownOld  is 

begin 

abort  CurState  .CurReadar ; 
abort  CurS tate . CurWr i ter ; 

Oestroy_Queue(CurStata. InputCharBuff ar ) ; 

Destroy_Queue( CurSt ate .  OutputChar Buffer) ; 
end  ShutDownOld; 

procedure  Startup  is 
begin 

CurState  :*  new  OriverStataBlock ; 

Init_Queue(CurStata  .  InputCharBuf f ar ) ; 

Ini t_Queue( CurState .OutputC bar Buffer); 

CurS tata . CurReader . S tar tUpOona :  • 

CurState.CurWriter.S  tartUpOone; 
end  Startup; 
begin 

Startup ; 

Console_0pe rat  ions : 

loop 

select 

accept  Read_Char acter(  C  :  out  Character)  do 
Remove  ( CurState .  InputCfiar  Buffer,  C); 
end  Read_Character ; 
or 

accept  Write_Cfiaracter(C  :  in  Character)  do 
Append(CurState.OutputCharBuffar,  C); 
end  Write_Character ; 
or 

accept  Reset  do 
ShutDownOld ; 

Startup ; 
end  Reset; 
or 

accept  ShutOown; 

ShutOownOl d ; 

exit  Console_Oparations; 

or 

terminate; 
end  select ; 

end  loop  Consola_Operations ; 
exception 

when  others  *> 

ShutOownOl d : 


end  Termi na 1 _0r i var ; 

?nd  Tg' — i-  na  '  _0"  *  ve r_°ac)cage  ; 


o'',  -*t  :<n 


Pr  -ic: 


Teaching  Packages 


□  Start  at  the  PACKAGE  level  and 
then  introduce  the  syntax  by 
example  —  NOT  at  the  syntax 
level  and  then  intro  packages 
—  good  way  to  produce  Fortran 
programs  written  in  Ada 

□  Give  students  preconstructed 
packages  and  have  them  build 
defined  products  with  them 

□  Have  students  play  "client" 
package  and  package  developer 

□  Have  students  develop  a  larger 
scale  system  with  packages  that 
must  interface 

□  Have  students  build  a  system 
which  has  a  heirarchical  structure 
of  packages 

□  Have  students  do  a  package  and 
replace  its  implementation  and 
observe  results 


□  Give  students  package  with  "open" 
data  structure  in  the  spec  and 
have  them  corrupt  its  integrity 
and  then  challenge  them  to  do 
the  same  thing  with  a  package 
with  the  data  structure  in  the 
private  part  of  the  spec 

□  Data  structures  course  very  easy 
vehicle  for  introducing  packages 
under  topic  of  abstraction 

□  Digital  design  course  offers 
opportunity  to  intro  packages 
to  encapsulate  abstract-state 
machines  and  tasks 
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task  [type)  [is 

{ entry_declarat ion} 

{ representational ause } 
end  [ task_aimple_name]  ) 


task  body  task_simple_name  is 
[declarat ive_par t] 

begin 

[ sequence_of_statements ) 
[exception 

except ion_handler 
{except ion_handler } ) 
end  [ task_simple_naine]  ; 
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Simplest  Form  op  Task  Entry 


ACCEPT 

Task  T1  is 

entry  ENTRY1; 
end  Tl; 


Task  body  Tl  is 

BEGIN 

LOOP 

ACCEPT  ENT  RY 1  DO 
<S0S> 

END  ENTRY 1 j 

<S0S> 


END  LOOP; 

END  Tlj 

--WAIT  FOREVER  FOR  CALL  TO  ENTRY1 
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END  T1 


Task  T1  is 

entry  ENTRY1; 
END  Tl; 


Task  body  Tl  is 

BEGIN 

LOOP 


accept  ENTRY1;  --'sync'  call  only 

<S0S> 

END  LOOP; 

END  Tl; 

--WAIT  FOREVER  FOR  CALL  TO  EN  TR  Y1 


"-EVEN  IF  ENTRY1  HAS  PARAMETERS  ASSOCIATED  WITH 

IT,  THE  ACCEPT  BLOCK  DOES  NOT  HAVE  TO  HAVE  A 
SEQUENCE  OF  STATEMENTS 
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SELECT  Statement 


Used  by  the  task  to  allow  options 

Simplest  form  is  the  selective  wait  (wai 

Task  T1  is 

entry  ENTRY1; 
entry  ENTRY2; 
end  T1 ; 


Task  body  T1  is 

BEGIN 

LOOP 

SELECT 

ACCEPT  ENTRY1  DO 
<S&$> 

end  ENTRY1; 

<S0S> 

OR 

accept  ENTRY2  do 

<sos> 

end  ENTRY2; 

<S0S> 

--as  many  'or'  and  accept  clauses  as 


END  SELECT; 

END  LOOP; 

END  Tl; 

-wait  for  either  ENTRY!  or  ENTRY2 


forever) 


NEEDED 
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Selective  wait  with  else  (don't  wait  at  all) 


Task  T1  is 

entry  ENT R Y 1 ; 
END  Tl; 


Task  body  Tl  is 
BEG  IN 
LOOP 
SELECT 

ACCEPT  ENTRY1  DO 

<sos> 

end  ENTRY1; 

<  SOS  > 
else 
<S0S> 

END  SELECT; 

END  LOOP; 

END  Tl; 

[f  THERE  IS  NOT  A  CALLER  WAITING  RIGHT  NOW, 
DO  THE  ELSE  PART. 
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Selective  wait  with  else,  multiple 
accepts 

Task  T1  is 

entry  ENTRY1; 
entry  ENTRY2 ; 

END  Tl; 


i"  A  S  K  BODY  Tl  IS 
BEGIN 
LOOP 

SELECT 

accept  ENTRY1  DO 

<sos> 

END  ENTRY1; 

<sos> 

OR 

accept  ENTRY2  do 

•  •  • 

--  AS  MANY  'OR'  AND  'ACCEPT'  CLAUSES  AS  NEEDED 


ELSE 

<  SOS >  ; 

END  SELECT; 
END  LOOP; 

END  Tl; 


Select  with  delay  alternative 
(wait  a  finite  time) 

Task  body  T1  is 

BEGIN 

LOOP 

SELECT 

ACCEPT  ENT R Y 1  DO**** 

(  OR 

accept  ENTRY2 . 1 

OR 

DELAY  15.0;  --SECONDS 

<S0S>; 

END  SELECT; 

END  LOOP; 

END  Tl; 

If  ENTRY1  called  within  15  seconds, 

THEN  YOU  ACCEPT  THE  CALL*  OTHERWISE, 
AFTER  15  SECONDS  YOU  WILL  DO  SOMETHING* 
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'DELAY'  Rules 


YOU  MAY  HAVE  SEVERAL  ALTERNATIVES 
WITH  A  DELAY  STATEMENT. 

Since  delays  can  be  static,  the  shortest 

DELAY  ALTERNATIVE  WILL  RE  SELECTED* 

Zero  and  negative  delays  are  Legal- 


i 


YOU  MAY  NOT  HAVE  AN  ELSE  PART  WITH 
A  DELAY,  SINCE  THE  DELAY  WOULD  NEVER 
BE  ACCEPTED- 


I 

i 
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'DELAY'  Rules 


YOU  MAY  HAVE  SEVERAL  ALTERNATIVES 
WITH  A  DELAY  STATEMENT. 

Since  delays  can  be  static,  the  shortest 

DELAY  ALTERNATIVE  WILL  RE  SELECTED* 

Zero  and  negative  delays  are  Legal. 


You  MAY  NOT  HAVE  AN  ELSE  PART  WITH 
A  DELAY,  SINCE  THE  DELAY  WOULD  NEVER 
BE  ACCEPTED- 
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Select  with  delay  alternative 
(wait  a  finite  time) 


Task  body  T1  is 

BEGIN 

loop 

SELECT 

ACCEPT  ENTRY1  DO • • • • 

[  OR 

accept  ENTRY2 . ] 

OR 

DELAY  <EXPRESS10N>; 

<SQS> ; 

OR 

DELAY  <EXPRESS ION>; 

<S0$>; 

-'SHORTEST  DELAY  WILL  GET  CHOSEN 

END  SELECT; 

END  LOOP; 

END  Tl; 
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Guards  can  be  used  on  any  accept 

STATEMENT 


“when  S0ME_C0ND  I T I  ON  => 
accept  ENTRY1  . 


If  there  is  no  GUARD,  the  accept  statement 
IS  SAID  TO  BE  OPEN. 

If  there  is  a  GUARD,  and  the  WHEN  condition 
IS  TRUE,  THE  ACCEPT  IS  ALSO  OPEN- 

False  GUARD  statements  are  said  to  be  CLOSED. 

OPEN  ALTERNATIVES  ARE  CONSIDERED-  If  THERE  IS 

more  than  one,  then  ONE  IS  SELECTED  ARBITRARILY- 

If  there  are  NO  OPEN  ALTERNATIVES  (and  no  else 
part),  the  exception  PROGRAM_ERROR  is  raised. 


TERMINATION 


When  a  task  has  completed  its  sequence 

OF  STATEMENTS  ,  ITS  STATUS  IS  COMPLETED 

Additionally,  there  is  an  option  that 

ALLOWS  A  TASK  TO  TERMINATE* 


SELECT 

ACCEPT  ENTRY1  DO  . 

[  OR 

accept  ENTRY2  do . 1 

OR 

TERMINATE; 

END  SELECT; 

This  may  not  be  used  with  either  the 
the  DELAY  or  an  ELSE  clause* 

Since  this  is  used  only  with  a  'wait  forever' 

TASK,  THIS  OPTION  ALLOWS  A  TASK  THAT  IS 
WAITING  FOREVER  TO  TERMINATE  IF  ITS  PARENT 
IS  ALSO  READY  TO  QUIT* 
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KILLING  A  TASK 
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PROBLEMS  WITH  PARALLELISM 
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task  SEMAPHORE  is 

ENTRY  P;  -’GET  RESOURCE 
ENTRY  V;  "“RELEASE 

end  SEMAPHORE; 

task  body  SEMAPHORE  is 

AVAILABLE  :  BOOLEAN  TRUE; 

BEGIN 

LOOP 

SELECT 

when  AVAILABLE 

ACCEPT  P  DO 

AVAILABLE  :=  FALSE; 

END  P; 

OR 

when  not  AVAILABLE 

ACCEPT  V  DO 

AVAILABLE  :=  TRUE; 

END  V; 

OR 

TERM  I  NATE  ; 

END  LOOP; 

end  SEMAPHORE; 
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Task  Special  Ops  is 

entry  ASSIGN  (  Object  :  in  Some_Type  ); 
entry  RETRIEVE  (  Object  :  out  Some_Type); 
end  Special_Ops; 


Task  body  Special_Ops  is 
The_Object  :  Some_type; 
begin 

LOOP 

SELECT 

accept  ASS  I GN (Object : in  Some_Type)do 
The  Object  :=  Object; 
end  ASSIGN; 

OR 

accept  RET R I  EVE ( Object : out  Some_type)do 
Object  :=  The_Qbject; 
end  RETRIEVE; 

OR 

TERMINATE; 

END  SELECT; 

END  LOOP; 

end  Special_Ops; 
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CALLING  A  TASK  ENTRY 
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CALL  AND  WAIT  FOREVER 


TO  CALL  AN  ENTRY,  SPECIFY  THF 
TASK  NAME  AND  THEN  THE  FNTRY  NAME 


BEGIN 

*  Tl-ENTRYl(DATA); 
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TIMED  ENTRY  CALL 

(wait  for  a  finite  time) 

SELECT 

Tl.ENTRYl(DATA); 

<sos> 

OR 

DELAY  60  J 

<sos> 

END  SELECT; 


YOU  CANNOT  USE  AN  'OR'  TO  CALL  TWO  (or  more) 
TASK  ENTRIES! ! ! 

This  would  be  equivalent  to  standing  in  two 

DIFFERENT  LINES  AT  ONCE* 
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CONDITIONAL  ENTRY  CALLS 

(don't  wait  at  all) 


SELECT 

Tl.ENTRYl(DATA); 

<S0S> 

ELSE 

<S0S> 

END  SELECT; 


Notice  the  'orthogonality'  or  the 
SELECT  statement-  It  is  used  in 
either  a  task  entry  call  or  an 

ACCEPT  STATEMENT. 


Also  notice  that  instead  of 

' ACCEPT  ...  BEG  I N ...  END  ACCEPT; 

IT  IS 

'accept*. .do - end  ENTR Y_NAME ; 

WHY??? 
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TASK  ATTRIBUTES 
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TASK  PRIORITIES 
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SYNCHRONIZATION  OF  DATA 


TASK  SYNC  IS 

ENTRY  UPDATE  (  DATA  :  in  DATATYPE); 
entry  READ  (  DATA  :out  DAT A_T Y P E ) ; 
end  SYNC; 

TASK  BODY  SYNC  IS 
LOCAL  :  DATATYPE; 

BEGIN 

LOOP 

SELECT 

accept  UPDATE ( DAT  A  :  in  DATA  TYPE)  do 
LOCAL  :=  DATA; 
end  UPDATE; 

OR 

TERMINATE; 

END  SELECT; 

SELECT 

ACCEPT  READ  (DATA  :  out  DATA  TYPE)  do 
DATA  :=  LOCAL; 
end  READ; 

OR 

TERMINATE; 

END  SELECT; 

END  LOOP; 

END  SYNC; 
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S3 


FAMILIES  OF  ENTRIES 


type  URGENCY  is  (LOW,  MEDIUM,  HIGH); 
task  MESSAGE  is 

ENTRY  RECE I VE( URGENCY )  (DATA  :  DAT A_T Y PE ) ; 
end  MESSAGE; 

task  body  MESSAGE  is 

BEGIN 

LOOP 

S E acc ept  RECE 1 VE ( HIGH)  (DATA: DAT A_T Y PE >  do 
end  RECEIVE; 

OR 

when  RECE I VE( HI GH  ) ' count  =  0  => 

accept  RECEI VE(MEDIUM)  ( DATA : DATATYPE)  do 

END  RECEIVE; 

OR 

WHEN  RECE  I  VE  (HIGH) '  count+RECE  I  VE(  MEDIUM ) '  count=()  => 
accept  RECEI VE( LOW)  ( DATA : DAT A_TYPE )  do 

end" RECE I VE ; 

OR 

DELAY  1.0;  --  SHORT  WAIT 

end  MESSAGE; 
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Same  thing,  with  no  guards 


type  URGENCY  IS  (LOW,  MEDIUM,  HIGH); 
task  MESSAGE  is 

entry  RECE  I  VE(  URGENCY )  (DATA  ;  DATATYPE); 
end  MESSAGE; 

task  body  MESSAGE  is 

BEGIN 

LOOP 

SELECT 

accept  RECE1VE(  HIGH  )  (DATA:  DATATYPE)  do 
end  RECEIVE; 

else 

SELECT 

accept  RECEIVE(MEDIUM)  (DATA: DAT A_T YPE )  do 
end  RECEIVE; 

ELSE 

SELECT 

accept  RECE I VE( LOW )  ( DATA : DATA  TYPE)  do 


end  RECEIVE; 
or 

delay  1.0;  --  SHORT  WAIT 
END  SELECT; 

END  SELECT; 

END  SELECT; 

END  MESSAGE; 


REPRESENTATION  SPECIFICATIONS 


Length  Clause 


T ' STORAGE _ S I ZE 

TASK  TYPE  T1  IS 
ENTRY  ENTRY  1; 

FOR  Tl'STORfiGE.SIZE  use 

2000*SYSTEM.STORA6E_UNIT); 

END  Tl; 

The  prefix  T  denotes  a  task  type. 

The  simple  expression  may  be  static,  and  is  used 

TO  SPECIFY  THE  NUMBER  OS  STORAGE  UNITS  TO  RE 
RESERVED  OR  FOR  EACH  ACTIVATION  (NOT  THE  CODE)  OF 
THE  TASK. 
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Address  Clause 


TASK  TYPE  T1  IS 

ENTRY  ENT RY_1 ; 

FOR  T1  USE  AT  16#167A#; 

END  Tl; 

In  this  case,  the  address  specifies  the  actual 

LOCATION  IN  MEMORY  WHERE  THE  MACHINE  CODE 
ASSOCIATED  WITH  Tl  WILL  BE  PLACED* 


task  Tl  is 

ENTRY  ENTR Y_1 ; 

for  ENTRY_1  use  at  16#40#; 

END  Tl; 


If  this  case,  ENTR Y_1  will  be  mapped  to  hardware 

INTERRUPT  64. 

Only  in  parameters  can  be  associated  with 

INTERRUPT  ENTRIES- 

An  interrupt  will  act  as  an  entry  call  issued  by 

THE  HARDWARE,  WITH  A  PRIORITY  HIGHER  THAN  ANY 
USER-DEFINED  TASK- 

Depending  upon  the  implementation,  there  can  be 
many  restrictions  upon  the  type  of  call  to  the 
interrupt,  and  upon  the  terminate  alternatives. 


NOTE:  you  can  directly  call  an  interrupt  entry. 


43 


TASKS  AT  DIFFERENT  PRIORITIES 


Given  5  tasks,  3  of  varying  priority,  1  to  be  interrupt 

DRIVEN,  AND  1  THAT  WILL  BE  TIED  TO  THE  CLOCK. 

procedure  HEAVY_STUFF  is 
TASK  H I GH_PR I  OR  I TY  is 

PRAGMA  PRlORlTY(50) ;  -“OR  AS  HIGH  AS  SYSTEM  ALLOWS 
ENTRY  POINT; 

END  H I GH_PR I  OR  I TY; 

task  MEDIUM_PRIORITY  is 
PRAGMA  PR  I  09  I TY( 25  )  ; 

ENTRY  POINT; 
end  MEDIUM_PRIORITY; 

TASK  LOW _ P  R I  OR  1 TY  is 

PRAGMA  PRIORITY! 1  )  ; 

ENTRY  POINT; 

END  LOW_PRI OR  I TY; 

task  I NTERRUPT_DRI VEN  is 

ENTRY  POINT; 

for  POINT  use  at  16^61*;  --interrupt  97 
END  I M TE RR 1) P T_D RIVEN ; 

task  CLOCK_DRIVEN  is 

--there  are  two  ways  to  do  this 

--First  way  is  to  have  another  task  monitor 
--  the  clock,  and  call  C LOC K_DR I VEN .CALL 

--  EVERY  TIME  UNIT. 

ENTRY  CALL; 

--Second  way  is  to  actually  tie  CALL  to  an 
--  clock  interrupt,  and  let  CALL  determine  when 

--  HE  WISHES  to  PERFORM  AN  ACTION 

for  CALL  use  at  16#32#;  --assume  interrupt  50 

--  IS  A  CLOCK  INTERRUPT 

end  CLOCK  DRIVEN; 

END  HEAVY_STUFF; 


task  QUEUE  is 

ENTRY  INSERT  ( DATA  :  in  DATATYPE); 
entry  REMOVE (DATA  :out  DAT A_T YPE ) ; 
end  QUEUE; 

task  body  QUEUE  is 

HEAD, TAIL  :  INTEGER  :=  0; 

Q  :  array  ( 1 . - 100)  of  DAT A_T Y PE ; 

BEGIN 

LOOP 

SELECT 

when  TAIL  -  HEAD  ♦  1  /=  0  and  then 
TAIL  -  HEAD  +  1  /=  100  => 
accept  INSERT ( DAT  A  :  in  DAT  A_T  YPE )  do 

if  HEAD  =  0  then  HEAD  :  =  1;  end  if; 
if  TAIL  =  100  then  TAIL  :=  0;  end  if; 
TAIL  TAIL  +  1; 

Q( TAIL)  :=  DATA; 
end  INSERT; 

OR 

when  HEAD  /=  0  => 

accept  REM0VE( DATA  :out  DAT A__T YPE)  do 
DATA  :=  Q( HEAD ) ; 
if  HEAD  =  TAIL  then 
HEAD  :=  0; 

TAIL  :=  0; 

ELSE 

HEAD  :=  HEAD  +  1; 

if  HEAD  >  100  then  HEAD  :=  1;  end  if 
end  if; 
end  REMOVE; 

OR 

TERM  I  NATE ; 

END  SELECT; 

END  LOOP; 

END  QUEUE; 
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TASK  TYPE  QUEUE  IS 

entry  INSERT ( DATA 
entry  REMOVE( DATA 
end  QUEUE; 


:  in  DATATYPE); 
:out  DAT A_T Y P E )  ; 


TASK  BODY  QUEUE  IS 

HEAD, TAIL  ;  INTEGER  0; 

Q  :  array  (1- - 100)  of  DATA_TYPE; 

BEGIN 

LOOP 

SEwhen  TAIL  -  HEAD  +  I  /=  0  and  then 
TAIL  -  HEAD  ♦  1  /-  100  =>  r 
accept  INSERT < DATA  :  in  DATATYPE)  do 

if  HEAD  =  0  then  HEAD  :*  1;  end  if; 
if  TAIL  =  100  then  TAIL  :*  0;  end  if; 
TAIL  TAIL  ♦  1; 

Q( TAIL)  :=  DATA; 
end  INSERT; 


WHEN  HEAD  /-  0  runc\ 

accept  REMOVE (  DATA  : out  DATATYPE)  no 
DATA  :»  Q( HEAD ) ; 
if  HEAD  =  TAIL  then 
HEAD  0; 

TAIL  0; 


ELSE 

HEAD  :=  HEAD  +  1;  r  n 

if  HEAD  >  100  then  HEAD  :=  1;  cnd 

END  IF; 

end  REMOVE, 


or 


terminate; 

END  SELECT; 

end  loop; 

END  QUEUE; 


MY  QUEUE,  YOU'O'JEUE  :  QUEUE.  -- 


"  W  ^ 


AD-A189  641 


UNCLASSIFIED 


ADVANCED  ADA  WORKSHOP  AUGUST  1987(U)  ADA 
OFFICE  ARLINGTON  UA  21  AUG  8? 


JOINT  PROGRAM  4/4 


F/G  12/5 


END 

•f'gs 


▼ 


GENERIC 

DATA  TYPE  : 
QUEUE_SIZE: 


private; 

POSITIVE 


package  QUEUE_PACK  is 

task  QUEUE  is 

entry  INSERT ( DAT  A 
entry  REMOVE ( DATA 
end  QUEUE; 


100; 


;  in  DATATYPE); 
our  DATATYPE); 


PACKAGE  BODY  QU£UE_PACK  IS 
TASK  BODY  QUEUE  IS 

HEAD, TAIL  :  INTEGER  :«  0;  „ATA  Tx/nc 
Q  :  array  ( 1 • -  QUEUE _ S I ZE)  of  D  AT  A _ TYPE ; 

BEGIN 

LOOP 

SELECT 

when  TAIL  -  HEAD  +  1  /-  0  and  then 
TAIL  -  HEAD  +  1  /-  QUEUE  SIZE  => 
accept  INSERT ( DATA  :  in  DATATYPE)  do 
if  HEAD  «  0  then  HEAD  :=  1;  end  I 
if  TAIL  =  QUEUE_SI ZE  then  TAIL  := 
TAIL  :=  TAIL  ♦  T; 

Q( TAIL )  DATA; 
end  INSERT; 

when  HEAD  /=  0  => 

accept  REMOVE ( DATA  :out  DATATYPE)  do 
DATA  :=  Q ( HEAD ) ; 
if  HEAD  =  TAIL  then 
HEAD  :=  0; 

TAIL  :=  0; 

ELSE 

HEAD  :=  HEAD  +  1; 

if  HEAD >  QUEUE_SI ZE  then  HEAD 

END  IF; 

END  REMOVE; 

OR 

TERMINATE; 

END  SELECT; 

END  LOOP; 

end  QUEUE; 


package  N E W_Q U E U E 
package  OLD  QUEUE 


is 
i  s 


new  QUEUE  PACK ( MY  RECORD, 
new  QUEUE_PACK( INTEGER); 


F; 

0;  END  IF; 


:=  1;  END  IP 


250); 
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procedure  INSERT  INTEGER  (DATA  :  in  INTEGER 
OLD_QUEUE ♦ INSERT; 

procedure  REMOVE_I NTEGER  (DATA  :out  INTEGER 
OLD_QUEUE . REMOVE  j 


RENAMES 

RENAMES 
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PROCEDURE  SPIN  (R  : 
BEGIN 
LOOP 
SELECT 

R. SEIZE; 

return; 

ELSE 

null;  --busy 
end  select; 
end  LOOP; 
end; 


-OR— 

procedure  SPIN  (R  ; 

BEGIN 

R. SEIZE; 

return; 

END} 


RESOURCE)  is 


WAITING 


RESOURCE)  is 
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end  select; 
end  loop; 
end  SPOOLERS 
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in-class  exercise 


task  T AS K_2  is 


end  TASK_2; 


task  T AS K _3  is 


end  TASK_3; 
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Tasking  Exercise 


Write  a  main  program  and  two  tasks  to  simulate  a  house  alarm 
system-  The  main  program  is  an  input  simulator  to  the 
tasks.  One  task  keeps  track  of  the  status  of  the  house. 
Another  is  the  actual  alarm  system. 


Task  1:  The  House  Status  (Task  Name  : HOU SE ) 

Three  Entries  =>  OK,  NOT_OK,  WRITE 

The  entries  OK  and  NQT_0K  set  or  reset  a  flag  that 

DETERMINES  THE  STATUS  OF  THE  HOUSE.  N0TJ1K  WILL  ALSO  SET  A 
VARIABLE  TO  TELL  YOU  WHICH  ALARM  IS  CURRENTLY  GOING  OFF. 

Both  OK  and  N0T__0K  should  print  out  a  message  verifying  that 

THEY  WERE  CALLED*  The  WRITE  ENTRY  WILL  PRINT  THE  STATUS  OF 
THE  HOUSE*  IF  THERE  IS  AN  ALARM  CURRENTLY  GOING  OFF,  WRITE 
WILL  TELL  YOU  THE  ALARM  NUMBER* 


Task  2:  The  Alarm  System  (Task  name:  ALARM) 

Three  Entries  =>  FIRE,  INTRUDER,  SHUTOFF 

The  Alarm  System  will  accept  any  of  the  three  entry 

CALLS  FROM  THE  INPUT  SIMULATOR.  If  THERE  ARE  NO  ENTRY  CALLS 
WITHIN  5  SECONDS,  IT  WILL  CALL  HOUSE -WRITE  TO  DISPLAY  THE 

status-  FIRE  and  INTRUDER  each  have  a  parameter  indication 

THE  ALARM  LOCATION.  FIRE  LOCATIONS  ARE  '1'  THRU  '9'. 

INTRUDER  locations  are  'A'  thru  'Z'.  FIRE  and  INTRUDER 
should  call  HOUSE • NOT _0 K  (and  tell  the  house  where  the  alarm 
is  sounding),  and  then  print  out  a  message 


Main  Program 

The  main  program  will  read  in  characters  from  the 
keyboard-  If  the  character  is  a  '1'  thru  '9',  call  the  fire 
alarm.  If  the  character  is  a  'A'  thru  ' Z'  then  it  calls  the 
intruder  alarm.  If  the  character  is  a  'O'(zero),  the  house 
is  reset  to  OK.  If  the  character  is  a  then  the  alarm 
is  shutdown,  and  the  program  ends.  All  other  characters  do 
nothing* 


The  house  status  should  be  OK  to  start. 
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run  cookie 


The  house  is  ok 

The  house  is  ok 
& 

Invalid  character.  Try  again 

The  house  is  ok 
G 

House  alarm  set  to  not  OK  at  location  G 
Intruder  in  room  G 

The  house  is  not  ok  ..alarm  is  off  at  location  G 

The  house  is  not  ok  ..alarm  is  off  at  location  G 

4 

House  alarm  set  to  not  OK  at  location  4 
Fire  Alarm  t  4  has  been  set  off. 

The  house  is  not  ok  ..alarm  is  off  at  location  4 
0 

House  alarm  reset  to  OK. 

The  house  is  ok 

The  house  is  ok 

j 

The  alarm  has  been  turned  off 

*> 
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PROCEDURE  COOKIE  IS 
CHAR  :  CHARACTER ; 


TASK  HOUSE  IS 
ENTRY  OK; 

entry  HOT  OK  (WHEREtCHARACTER); 

ENTRY  WRITE; 

END  HOUSE  ; 

task  ALARM  is 

ENTRY  FIRE  (LOCATION : CHARACTER ) ; 
ENTRY  INTRUDER  (LOCATION : CHARACTER); 
entry  SHUTOFF; 
end  ALARM  ; 


TASK  BODY  HOUSE  IS 

TYPE  CONDITION  IS  (OK,  NOT  OK); 

ALARM  STATUS  :  CONDITION  OK; 

ALARMILOCATION  :  CHARACTER; 

BEG  IN 

LOOP 

SELECT 

ACCEPT  OK  DO 

ALARM  STATUS  :=  OK; 

PUT_LTNE( 'House  alarm  reset  to  OK.'); 
end  OK; 

OR 

ACCEPT  NOT  OK  (WHEREiCHARACTER)  do 
ALARM  STATUS  :=  NOT  OK; 

ALARM  LOCATION  :=  WffERE; 
put_LTNE( 'House  alarm  set  to  not  OK  at"& 
'location  '  &  ALARM_LOCATION); 

END  NOT_OK; 

OR 

accept  WRITE  DO 
NEW _ L I NE ; 

case  ALARM.STATUS  is 
when  OK  ss>PUT_LINE('The  house  is  ok"); 

wVien  N0T_0K  «>  PUT _ L l NE 

("The  house  is  not  ok"& 

'  ..ALARM  IS  OFF  AT  LOCATION  "  & 

ALARM_LOCAT ION); 

END  CASE; 

NEW  LINE; 
end  WRITE; 

OR 

terminate; 

END  SELECT; 

END  LOOP; 

end  HOUSE  ; 
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TASK  BODY  ALARM  is 
BEGIN 

LOOP 

SELECT 


OR 


OR 


OR 


iJcEPT  FIRE  (LOCATION: CHARACTER)  do 
HOUSE.NOOK(LOCATION); 

PUT  ("Fire  Alarm  #  ); 

PUT  (LOCATION); 

PUT  LINE  (*  has  been  set  off. 

end  FIRF; 

accept  INTRUDER  (LOCATION .'CHARACTER)  do 
HOUSE-  NOT_OK  (LOCATION)^ 

PUT  ('Intruder  in  room  ); 

PUT  (LOCATION); 

NEW  LINE; 
end  INTRUDER; 

PUt!.LINEH( "The*  alarm  has  been  turned  off  ); 
exit; 


DELAY  5.0; 
HOUSE. WRITE; 

END  SELECT; 

END  loop; 
end  ALARM; 
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--MAIN 


BEGIN 

LOOP 


GET  (CHAR); 
SKIPJJNE; 
case  CHAR  is 

*  i  * 


WHEN  '1'  •  • 

'9' 

«> 

ALARM. FIRE  (CHAR); 

WHEN  'A'  •• 

'z' 

=> 

ALARM. INTRUDER  (CHAR); 

WHEN  'A'  •• 

•v 

=> 

ALARM- INTRUDER  (CHAR); 

WHEN  'O' 

*> 

HOUSE- OK; 

WHEN  ' ! ' 

=> 

ALARM. SHUTOFF; 

WHEN  OTHERS 

*> 

PUT.LINE 

( 

Invalid 

CHARACTER*  Try  AGAIN- 

END  CASE; 

EXIT  WHEN  CHAR 

*  ' ! 

t  t 

J 

END  LOOP; 

end  COOKIE; 
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Outline 


=>  Overview 
•  Nanning  an  exception 
.  Creating  an  exception  handler 

•  Raising  an  exception 

•  Handling  exceptions 

.  Turning  of!  exception  checking 
•  Tasking  exceptions 


•  More  examples 


©ven/tew 


\ 


What  is  an  exception 

Ada  exceptions 

Comparison 

*  the  American  way 


-  using  exceptions 


Whal  Is  an  ExespSten 


•  A  run  time  error 


•  An  unusual  or  unexpected  condition 


•  A  condition  requiring  special  attention 


•  Other  than  normal  processing 


Ada 


An  exception  has  a  name 

-  may  be  predefined 

-  may  be  declared 

The  exception  is  raised 

-  may  be  raised  implicitly  by  run  time  system 
*  may  be  raised  explicitly  by  raise  statement 

The  exception  is  handled 

-  exception  handler  may  be  placed  in  any  frame 

-  exception  propagates  until  handler  is  found 

-  if  no  handler  anywhere,  process  aborts 


Ths  Amanean  Way 


package  Slack_Package  is 

type  Stack_Type  is  limited  private; 

procedure  Push  (Stack  ;  in  out  Stack_Type; 

Element :  in  ElementJType; 
Overflow_Flag  ;  out  boolean); 


end  Stack_Package; 


with  TexMO; 

with  Stack_Package;  use  Stack_Package; 
procedure  Flag_Waving  is 

Stack  :  Stack_Type; 

Element :  Element_Type; 

Flag  :  boolean; 

begin 


Push  (Stack,  Element,  Flag); 
if  Flag  then 

TextJO.Put  ("Stack  overflow"); 


end  if; 

•  •  • 

end  F!ag_Waving; 


f 


V 
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rnj  Exception 


package  Stack_Package  is 

type  Stack_Type  is  limited  private; 
StackjDverflow, 

Stack_Underflow  :  exception; 

procedure  Push  (Stack  ;  in  out  Stack_Type; 

Element ;  in  E!ement_Type); 
--  may  raise  StackjDverflow 

•  •  • 

end  Stack_Package; 


with  TextJO; 

with  Stack_Package;  use  Stack_Package; 
procedure  More_Natural  is 

Stack :  Stack_Type; 

Element  ;  Element_Type; 

begin 


Push  (Stack,  Element); 

•  •  • 

exception 

when  StackjDverflow  => 

TextJO. Put  ("Stack  overflow"); 

•  •  • 

end  More  Natural; 
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Oar]]  ns 


•  Overview 

=>  Naming  an  exception 

•  Creating  an  exception  handler 

•  Raising  an  exception 

•  Handling  exceptions 

•  Turning  off  exception  checking 

•  Tasking  exceptions 


•  More  examples 


tersymg  sm  Eim&pTim 


Predefined  exceptions 


Declaring  exceptions 


I/O  exceptions 


•  In  package  STANDARD  (also  see  chap  1 1  of  LRM) 

•  CONSTRAINT_ERROR 

violation  of  range,  index,  or  discriminant  constraint... 

•  NUMER!C_ERROR 

execution  of  a  predefined  numeric  operation  cannot 
deliver  a  correct  result 

•  PROGRAM_ERROR 

attempt  to  access  a  program  unit  which  has  not  yet 
been  elaborated... 

•  STORAGE_ERROR 

storage  allocation  is  exceeded... 

•  TASKING  ERROR 


exception  arising  during  intertask  communication 


Declaring  exceptions 


exception_declaration  ::=  identifier Jist  :  exception; 


•  Exception  may  be  declared  anywhere  an  object  declaration 
is  appropriate 


•  However,  exception  is  not  an  object 

-  may  not  be  used  as  subprogram  parameter,  record 

or  array  component 

-  has  same  scope  as  an  object,  but  its  effect  may 

extend  beyond  its  scope 


Example: 


procedure  Calculation  is 

Singular :  exception; 

Overflow,  Underflow  :  exception; 


begin 


end  Calculation; 


I/O  lizzspfiom 


•  Exceptions  relating  to  file  processing 


•  In  predefined  library  unit  IO_EXCEPTIONS 
(also  see  chap  14  of  LRM) 


•  TEXTJO,  DIRECT_IO,  and  SEQUENTIALJO  with  it 


package  IO_EXCEPTIONS  is 

NAME_ERROR  :  exception; 

USE_ERROR  :  exception;  -attempt  to  use 

-invalid  operation 

STATUS_ERROR  :  exception; 

MODE_ERROR  :  exception; 

DEVICE_ERROR  :  exception; 

END_ERROR  :  exception;  -attempt  to  read 

-beyond  end  of  file 

DATA_ERROR  :  exception;  -attempt  to  input 

-wrong  type 

LAYOUT_ERROR  '.exception;  -for  text  processing 
end  IO_EXCEPTIONS; 
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•  Overview 

•  Naming  an  exception 

=>  Creating  an  exception  handler 

•  Raising  an  exception 
.  Handling  exceptions 

•  Turning  olt  exception  checking 

•  Tasking  exceptions 


.  More  examples 


Defining  an  exception  handler 


Restrictions 


Handler  example 


Defining  an  exception  handler 


Restrictions 


Handler  example 


Dsfm'mg  an  Ex©ap'ii©n  Ha 


Exception  condition  is  "caught"  and  "handled"  by  an  exception 
handler 


Exception  handier  may  appear  at  the  end  of  any  frame  (block, 
subprogram,  package  or  task  body) 


begin 

exception 

--  exception  handler(s) 
end; 


*  Form  similar  to  case  statement 

exception_handler  ::**  *  . 

when  exception_choice  (j  exception_choice}  => 
sequence_of_statements 

exception_choice  ::=  exception_name  |  others 
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D©55n3ng  aft  Exc©p'H©n  Handlar 


Exception  condition  is  "caught"  and  "handled"  by  an  exception 
handler 


Exception  handler  may  appear  at  the  end  of  any  frame  (block, 
subprogram,  package  or  task  body) 


begin 

exception 

-  exception  handler(s) 
end; 


•  Form  similar  to  case  statement 


exception_handler  ::=  _ 

when  exception_choice  (1  exception_choice}  => 
sequence_of_statements 

exception_choice  ::=  exception_name  |  others 


IS 


issiridjons 


Exception  handlers  must  be  at  the  end  of  a  frame 


Nothing  but  exception  handlers  may  lie  between  excepti 
and  end  of  frame 


A  handler  may  name  any  visible  exception  declared  or 
predefined 


A  handler  includes  a  sequence  of  statements 
-  response  to  exception  condition 


A  handler  for  others  may  be  used 

-  must  be  the  last  handler  in  the  frame 

-  handles  all  exceptions  not  listed  in  previous 

handlers  of  the  frame 

(including  those  not  in  scope  of  visibility) 

-  can  be  the  only  handler  in  the  frame 
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procedure  Whatever  is 


Handler  E: 


Problem_Condition  :  exception; 


begin 


exception 

when  Prob!em__Condition  => 
Fix_lt; 

when  CONSTRAINT_ERROR  => 
Reportjt; 

when  others  => 

Punt; 

end  Whatever; 
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Ou'ilma 


•  Overview 

•  Naming  an  exception 

•  Creating  an  exception  handler 
=>  Raising  an  exception 

•  Handling  exceptions 

•  Turning  off  exception  checking 

•  Tasking  exceptions 

•  More  examples 
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'Rafeang  an  Exesplion 


How  exceptions  are  raised 
Effects  of  raising  an  exception 


Raising  example 


H&v;  £;<D8pliorjo  &?£  Flsusad 


Implicitly  by  run  time  system 

-  predefined  exceptions 

Explicitly  by  raise  statement 
raise_statement  ::=  raise  [exception_name]; 

-  the  name  of  the  exception  must  be  visible  at  the 

point  of  the  raise  statement 


-  a  raise  statement  without  an  exception  name  is 
allowed  only  within  an  exception  handler 


l'/IooIs  o'l  Raising  an  £:<e©p*r ion 


Control  transfers  to  exception  handler  at  end  of  frame 
(if  one  exists) 


Exception  is  lowered 


Sequence  of  statements  in  exception  hander  is  executed 


Control  passes  to  end  of  frame 


If  frame  does  not  contain  an  appropriate  exception  handler, 
the  exception  is  propagated 
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Raising  Exampla 


procedure  Whatever  is 

Problem_Condition  :  exception; 

Real__Bad_Condition  ;  exception; 

begin 

if  Prob!em_Arises  then 

raise  Probfern_Condition; 

end  if; 

if  Serious__Problem  then 

raise  Real_Bad_Condition; 

end  if; 
exception 

when  Prob!em_Condition  => 

Fixjt; 

when  CONSTRAINT_ERROR  => 
Reportjt; 

when  others  => 

Punt; 

end  Whatever; 
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•  Overview 

•  Naming  an  exception 

•  Creating  an  exception  handler 
.  Raising  an  exception 

=>  Handling  exceptions 

•  Turning  off  exception  checking 

•  Tasking  exceptions 

•  More  examples 
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•  Now  exception  handling  can  be  useful 


•  Which  exception  handler  is  used 


•  Sequence  of  statements  in  exception  handler 


•  Propagation 


•  Propagation  example 


Hdw  l^espiiori  rlantMing  ©an  3a  UaeM 


•  Normal  processing  could  continue  if 

-  cause  of  exception  condition  can  be  "repaired" 

-  alternative  approach  can  be  used 

-  operation  can  be  retried 

*  Degraded  processing  could  be  better  than  termination 

-  for  example,  safety-critical  systems 


•  If  termination  is  necessary,  "clean-up"  can  be  done  first 


Which  Ixcsplton  Hand]©?  1$  Used 


If  exception  is  raised  during  normal  execution,  system  looks 
for  an  exception  handler  at  the  end  of  the  frame  in  which  the 
exception  occurred 


If  exception  is  raised  during  elaboration  of  the  declarative 
part  of  a  frame 

elaboration  is  abandoned  and  control  goes  to  the 
end  of  the  frame  with  the  exception  still  raised 

*  exception  part  of  the  frame  is  not  searched  for  an 

appropriate  handler 

-  effectively,  the  calling  unit  will  be  searched  for  an 
appropriate  handler 

•  if  elaboration  of  library  unit,  program  execution  is 

abandoned 

--  all  library  units  are  elaborated  with  the 
main  program 


If  exception  is  raised  in  exception  handler 

-  handler  may  contain  block(s)  with  handler(s) 

-  if  not  handled  locally  within  handler,  control  goes 

to  end  of  frame  with  exception  raised 


Handler  completes  the  execution  of  the  frame 

-  handler  for  a  function  should  usually  contain  a 
return  statement 


Statements  can  be  of  arbitrary  complexity 

-  can  use  most  any  language  construct  that  makes 

sense  in  that  context 

-  cannot  use  goto  statement  to  transfer  into  a 

handler 

•  if  handler  is  in  a  block  inside  a  loop,  could  use  exit 
statement 


Handler  at  end  of  package  body  applies  only  to  package 
initialization 


Frspagsrtten 


•  Occurs  if  no  handler  exists  in  frame  where  exception  is  raised 

•  Also  occurs  if  raise  statement  is  used  in  handler 

•  Exception  is  propagated  dynamically 

-  propagates  from  subprogram  to  unit  calling  it 

(not  necessarily  unit  containing  its  declaration) 

-  this  can  result  in  propagation  outside  its  scope 

•  Propagation  continues  until 

-  an  appropriate  handler  is  found 

-  exception  propagates  to  main  program  (still  with 

no  handler)  and  program  execution  is  abandoned 


Prop  ci  g  ci  Vi  on  £*'» 


procedure  DoJ'Jothing  is 

procedure  Has_lt  is 

Some_Problem  :  exception; 

begin 

raise  SomeJ^roblem, 
exception 

when  Some_Problem  => 
Clean_Up; 
raise; 

end  Hasjt; 

procedure  Callsjt  is 
begin 

Hasjt; 
end  Callsjt; 
begin  -*  DoJ'Jothing 
Callsjt; 
exception 

when  others  =>  Fix_Everythmg; 
end  Do_Nothing; 
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Overview 


Naming  an  exception 


Creating  an  exception  handier 


Raising  an  exception 


Handling  exceptions 


>  Turning  off  exception  checking 


Tasking  exceptions 


More  examples 


Overhead  vs  E'nj^termy 


Exception  checking  imposes  run  time  overhead 

-  interactive  applications  will  never  notice 

-  real-time  applications  have  legitimate  concerns 

but  must  not  sacrifice  system  safety 

When  efficiency  counts 

-  first  and  foremost,  make  program  work 

-  be  sure  possible  problems  are  covered  by  exception 

handlers 

-  check  if  efficient  enough  -  stop  if  it  is 

-  if  not,  study  execution  profile 

-  eliminate  bottlenecks 

-  improve  algorithm 

-  avoid  "cute"  tricks 

-  check  if  efficient  enough  -  stop  if  it  is 

-  if  not,  trade-offs  may  be  necessary 

-  some  exception  checks  may  be  expendable  since 

debugging  is  done 

-  however,  every  suppressed  check  poses  new 

possibilities  for  problems 

-  must  re-examine  possible  problems 
--  must  re-examind  exception  handlers 

-  always  keep  in  mind 

--  problems  will  happen 
--  critical  applications  must  be  able  to 
deal  with  these  problems 
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Improving  the  aJ§efttbm-is  far  better  -  and  easier  in 
the  long  run  -  than  suppressing  checks 
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Pragma  SUPPRESS 


•  Only  allowed  immediately  within  a  declarative  part  or 
immediately  within  a  package  specification 


pragma  SUPPRESS  (identifier  [,[  ON  =>]  name]); 


-  identifier  is  that  of  the  check  to  be  omitted 

(next  slide  lists  identifiers) 

-  name  is  that  of  an  object,  type,  or  unit  for  which 

the  check  is  to  be  suppressed 

-*  if  no  name  is  given,  it  applies  to  the 
remaining  declarative  region 


•  An  implementation  is  free  to  ignore  the  suppress  directive 
for  any  check  which  may  be  impossible  or  too  costly  to 
suppress 


Example: 

pragma  SUPPRESS  (1NDEX_CHECK,  ON  =>  Index); 
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Icterriiitera 


•  i  hese  identifiers  are  explained  in  more  detail  in  chap  1 1  of 
the  LRM 


•  Check  identifiers  for  suppression  of  CONSTRA!NT_ERROR 
checks 


ACCESS_CHECK 

DISCRIM!NANT_CHECK 

!NDEX_CHECK 

LENGTH_CHECK 

RANGE_CHECK 


•  Check  identifiers  for  suppression  of  NUMERIC_ERROR  checks 

DIV(SION_CHECK 

OVERFLOVVCHECK 


•  Check  identifier  for  suppression  of  PROGRAM_ERROR  checks 
ELABORATION  CHECK 


•  Check  identifier  for  suppression  of  STORAGE_ERROR  check 


STORAGE  CHECK 


Ouillris 


•  Overview 


•  Naming  an  exception 


•  Creating  an  exception  handler 


•  Raising  an  exception 


•  Handling  exceptions 


•  Turning  off  exception  checking 


=>  Tasking  exceptions 


•  More  examples 


Tasking  E»c»pt5©ns 

Exception  handling  is  trickier  tor  tasks 
Exceptions  during  task  rendezvous 


Tasking  example 


Ex&spTmn  Handling  Is  Trlekter  1  or  Tas& 


•  Rules  are  not  really  different,  just  more  involved 

-  local  exceptions  handled  the  same  within  frames 

If  exception  is  raised 

•  during  elaboration  of  task  declarations 

-  the  exception  TASKING_ERROR  will  be  raised  at  the 

point  of  task  activation 

-  the  task  will  be  marked  completed 

•  during  execution  of  task  body  (and  not  resolved  there) 

-  task  is  completed 

-  exception  is  n^l  propagated 

•  during  task  rendezvous 

-  this  is  the  really  tricky  part 
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During 


If  the  called  task  terminates  abnormally 

exception  TASKING_ERROR  is  raised  in  calling  task  at  the 
point  of  the  entry  call 

If  the  calling  task  terminates  abnormally 
no  exception  propagates  to  the  called  task 


If  an  exception  is  raised  in  called  task  within  an  accept  (and 
not  handled  there  locally) 

the  same  exception  is  raised  in  the  calling  task  at  the  point 
of  the  entry  call 

(even  if  exception  is  later  handled  outside  of  the  accept  in 
the  called  task) 


If  an  entry  call  is  made  for  entry  of  a  task  that  becomes 
completed  before  accepting  the  entry 


exception  TASKING_ERROR  is  raised  in  calling  task  at  the 
point  of  the  entry  call 


Tasking  Ev<si r/jpla 


procedure  Critical_Code  is 
Failure  :  exception; 


task  Monitor  is 

entry  Do_Something; 
end  Monitor; 
task  body  Monitor  is 

begin 

accept  Do_Something  do 
••• 

raise  Failure; 

end  DoJSomething; 

exception  -  exception  handled  here 
when  Failure  =>  ' 

TerminationJVIessage; 

end  Monitor; 


begin  -•  Critical_Code 

Monitor.Do_Something; 

exception  -  same  exception  will  be  handled  here 
when  Failure  => 

Critical_Problem_Message; 


end  CriticaL_Code; 
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•  Overview 


•  Naming  an  exception 

•  Creating  an  exception  handler 

•  Raising  an  exception 

•  Handling  exceptions 

•  Turning  off  exception  checking 


•  Tasking  exceptions 


=>  More  examples 


•  Interactive  data  input 


•  Propagating  exception  out  of  scope  and  back  in 


•  Keeping  a  task  alive 


}M©7«!©‘Hv©  Dots.  Inpm 


with  Text  Jo;  use  Text  Jo; 

procedure  Getjnput  (Number :  out  integer)  is 

'  -vtype  tnput_Type  is  integer  range  0..100, 

package  Intjo  is  new  Integer  Jo  (lnput_Type), 

In^Number :  InputJType; 

begin  -  Getjnput 

loop  -  to  try  again  after  incorrect  input 

begin  -  Inner  block  to  hold  exception  handler 

put  (“Enter  a  number  0  to  100"); 

Intjo.get  (ln_Number); 

Number  ;=  ln_Number, 

exit;  -  to  exit  loop  after  correct  input 

eXCePwhen  DATA_ERROR  I CONSTRAINT.ERROR 
put  ("Try  again,  fat  fingers! ); 

Skip__Line;  -  must  clear  buffer 

end;  -  inner  block 


end  loop; 


end  Getjnput; 


ng  Exception 
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declare 

package  Container  is 

procedure  Has_Handler; 
procedure  Raises_Exception; 
end  Container; 

procedure  Not_in_Package  is 
begin 

Container.Raises_Exception; 

exception 

when  others  =>  raise; 
end  NotJn_Package; 


package  body  Container  is 
Crazy :  exception; 
procedure  Has_Handler  is 
begin 

Not_in_Package; 

exception 

when  Crazy  =>  Tell_Everyone; 
end  Has_Handler; 
procedure  Raises_Exception  is 
begin 

raise  Crazy; 

end  Raises_Exception; 
end  Container; 

begin 

Container.  Has_Handler; 


end; 


Keeping  ci  fi&ti  Aliy* 


task  Monitor  is 

entry  Do_Something; 
end  Monitor; 

task  body  Monitor  is 
begin 

loop  --  for  never-ending  repetition 
select 

accept  Do_Something  do 

begin  -  block  for  exception  handler 

raise  Failure; 

••• 

exception 

when  Failure  =>  Recover; 
end;  -  block 

end  Do_Something;  --  exception  must  be 

-  lowered  before  exiting 

end  select; 

end  loop; 

exception 

when  others  => 

Termination_Message; 
end  Monitor; 


